init
This commit is contained in:
150
livejournal/cgi-bin/LJ/Blob.pm
Executable file
150
livejournal/cgi-bin/LJ/Blob.pm
Executable file
@@ -0,0 +1,150 @@
|
||||
# Wrapper around BlobClient.
|
||||
|
||||
use strict;
|
||||
use lib "$ENV{'LJHOME'}/cgi-bin";
|
||||
use BlobClient;
|
||||
|
||||
package LJ::Blob;
|
||||
|
||||
my %bc_cache = ();
|
||||
my %bc_reader_cache = ();
|
||||
my %bc_path_reader_cache = ();
|
||||
|
||||
# read-write (i.e. HTTP connection to BlobServer, with NetApp NFS mounted)
|
||||
sub get_blobclient {
|
||||
my $u = shift;
|
||||
my $bcid = $u->{blob_clusterid} or die "No blob_clusterid";
|
||||
return $bc_cache{$bcid} ||=
|
||||
_bc_from_path($LJ::BLOBINFO{clusters}->{$bcid},
|
||||
$LJ::BLOBINFO{clusters}->{"$bcid-BACKUP"});
|
||||
}
|
||||
|
||||
# read-only access. (i.e. direct HTTP connection to NetApp)
|
||||
sub get_blobclient_reader {
|
||||
my $u = shift;
|
||||
my $bcid = $u->{blob_clusterid} or die "No blob_clusterid";
|
||||
|
||||
return $bc_reader_cache{$bcid} if $bc_reader_cache{$bcid};
|
||||
|
||||
my $path = $LJ::BLOBINFO{clusters}->{"$bcid-GET"} ||
|
||||
$LJ::BLOBINFO{clusters}->{$bcid};
|
||||
my $bpath = $LJ::BLOBINFO{clusters}->{"$bcid-BACKUP"};
|
||||
|
||||
return $bc_reader_cache{$bcid} = _bc_from_path($path, $bpath);
|
||||
}
|
||||
|
||||
sub _bc_from_path {
|
||||
my ($path, $bpath) = @_;
|
||||
if ($path =~ /^http/) {
|
||||
$bpath = undef unless $bpath =~ /^http/;
|
||||
return BlobClient::Remote->new({ path => $path, backup_path => $bpath });
|
||||
} elsif ($path) {
|
||||
return BlobClient::Local->new({ path => $path });
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
# given a $u, returns that user's blob_clusterid, conditionally loading it
|
||||
sub _load_bcid {
|
||||
my $u = shift;
|
||||
die "No user" unless $u;
|
||||
return $u->{blob_clusterid} if $u->{blob_clusterid};
|
||||
|
||||
# if the entire system only has one blob_clusterid, use that
|
||||
# without querying the database/memcache
|
||||
return $u->{blob_clusterid} = $LJ::ONLY_BLOB_CLUSTERID
|
||||
if defined $LJ::ONLY_BLOB_CLUSTERID;
|
||||
|
||||
LJ::load_user_props($u, "blob_clusterid");
|
||||
return $u->{blob_clusterid} if $u->{blob_clusterid};
|
||||
die "Couldn't find user $u->{user}'s blob_clusterid\n";
|
||||
}
|
||||
|
||||
# args: u, domain, fmt, bid
|
||||
# des-fmt: string file extension ("jpg", "gif", etc)
|
||||
# des-bid: numeric blob id for this domain
|
||||
# des-domain: string name of domain ("userpic", "phonephost", etc)
|
||||
sub get {
|
||||
my ($u, $domain, $fmt, $bid) = @_;
|
||||
_load_bcid($u);
|
||||
my $bc = get_blobclient_reader($u);
|
||||
return $bc->get($u->{blob_clusterid}, $u->{userid}, $domain, $fmt, $bid);
|
||||
}
|
||||
|
||||
# Return a path relative to the specified I<root> for the given arguments.
|
||||
# args: root, u, domain, fmt, bid
|
||||
# des-root: Root path
|
||||
# des-fmt: string file extension ("jpg", "gif", etc)
|
||||
# des-bid: numeric blob id for this domain
|
||||
# des-domain: string name of domain ("userpic", "phonephost", etc)
|
||||
sub get_rel_path {
|
||||
my ( $root, $u, $domain, $fmt, $bid ) = @_;
|
||||
|
||||
my $bcid = _load_bcid( $u );
|
||||
my $bc = $bc_path_reader_cache{ "$bcid:$root" } ||= new BlobClient::Local ({ path => $root });
|
||||
|
||||
return $bc->make_path( $bcid, $u->{userid}, $domain, $fmt, $bid );
|
||||
}
|
||||
|
||||
|
||||
sub get_stream {
|
||||
my ($u, $domain, $fmt, $bid, $callback) = @_;
|
||||
_load_bcid($u);
|
||||
my $bc = get_blobclient_reader($u);
|
||||
return $bc->get_stream($u->{blob_clusterid}, $u->{userid}, $domain, $fmt, $bid, $callback);
|
||||
}
|
||||
|
||||
sub put {
|
||||
my ($u, $domain, $fmt, $bid, $data, $errref) = @_;
|
||||
_load_bcid($u);
|
||||
my $bc = get_blobclient($u);
|
||||
|
||||
unless ($u->writer) {
|
||||
$$errref = "nodb";
|
||||
return 0;
|
||||
}
|
||||
|
||||
unless ($bc->put($u->{blob_clusterid}, $u->{userid}, $domain,
|
||||
$fmt, $bid, $data, $errref)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
$u->do("INSERT IGNORE INTO userblob (journalid, domain, blobid, length) ".
|
||||
"VALUES (?, ?, ?, ?)", undef,
|
||||
$u->{userid}, LJ::get_blob_domainid($domain),
|
||||
$bid, length($data));
|
||||
die "Error doing userblob accounting: " . $u->errstr if $u->err;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub delete {
|
||||
my ($u, $domain, $fmt, $bid) = @_;
|
||||
_load_bcid($u);
|
||||
my $bc = get_blobclient($u);
|
||||
|
||||
return 0 unless $u->writer;
|
||||
|
||||
my $bdid = LJ::get_blob_domainid($domain);
|
||||
return 0 unless $bc->delete($u->{blob_clusterid}, $u->{userid}, $domain,
|
||||
$fmt, $bid);
|
||||
|
||||
$u->do("DELETE FROM userblob WHERE journalid=? AND domain=? AND blobid=?",
|
||||
undef, $u->{userid}, $bdid, $bid);
|
||||
die "Error doing userblob accounting: " . $u->errstr if $u->err;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub get_disk_usage {
|
||||
my ($u, $domain) = @_;
|
||||
my $dbcr = LJ::get_cluster_reader($u);
|
||||
if ($domain) {
|
||||
return $dbcr->selectrow_array("SELECT SUM(length) FROM userblob ".
|
||||
"WHERE journalid=? AND domain=?", undef,
|
||||
$u->{userid}, LJ::get_blob_domainid($domain));
|
||||
} else {
|
||||
return $dbcr->selectrow_array("SELECT SUM(length) FROM userblob ".
|
||||
"WHERE journalid=?", undef, $u->{userid});
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
291
livejournal/cgi-bin/LJ/Cache.pm
Executable file
291
livejournal/cgi-bin/LJ/Cache.pm
Executable file
@@ -0,0 +1,291 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# LJ::Cache class
|
||||
# See perldoc documentation at the end of this file.
|
||||
#
|
||||
# -------------------------------------------------------------------------
|
||||
#
|
||||
# This package is released under the LGPL (GNU Library General Public License)
|
||||
#
|
||||
# A copy of the license has been included with the software as LGPL.txt.
|
||||
# If not, the license is available at:
|
||||
# http://www.gnu.org/copyleft/library.txt
|
||||
#
|
||||
# -------------------------------------------------------------------------
|
||||
#
|
||||
|
||||
package LJ::Cache;
|
||||
|
||||
use strict;
|
||||
use fields qw(items size tail head bytes maxsize maxbytes);
|
||||
|
||||
use vars qw($VERSION);
|
||||
use constant PREVKEY => 0;
|
||||
use constant VALUE => 1;
|
||||
use constant NEXTKEY => 2;
|
||||
use constant BYTES => 3;
|
||||
use constant INSTIME => 4;
|
||||
use constant FLAGS => 5; # caller-defined metadata
|
||||
|
||||
$VERSION = '1.0';
|
||||
|
||||
sub new {
|
||||
my ($class, $args) = @_;
|
||||
my $self = fields::new($class);
|
||||
|
||||
$self->init($args);
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub walk_items {
|
||||
my LJ::Cache $self = shift;
|
||||
my $code = shift;
|
||||
|
||||
my $iter = $self->{'head'};
|
||||
while ($iter) {
|
||||
my $it = $self->{'items'}->{$iter};
|
||||
$code->($iter, $it->[BYTES], $it->[INSTIME]);
|
||||
$iter = $it->[NEXTKEY];
|
||||
}
|
||||
}
|
||||
|
||||
sub init {
|
||||
my LJ::Cache $self = shift;
|
||||
my $args = shift;
|
||||
|
||||
$self->{'head'} = 0;
|
||||
$self->{'tail'} = 0;
|
||||
$self->{'items'} = {}; # key -> arrayref, indexed by constants above
|
||||
$self->{'size'} = 0;
|
||||
$self->{'bytes'} = 0;
|
||||
$self->{'maxsize'} = $args->{'maxsize'}+0;
|
||||
$self->{'maxbytes'} = $args->{'maxbytes'}+0;
|
||||
}
|
||||
|
||||
sub get_item_count {
|
||||
my LJ::Cache $self = shift;
|
||||
$self->{'size'};
|
||||
}
|
||||
|
||||
sub get_byte_count {
|
||||
my LJ::Cache $self = shift;
|
||||
$self->{'bytes'};
|
||||
}
|
||||
|
||||
sub get_max_age {
|
||||
my LJ::Cache $self = shift;
|
||||
return undef unless $self->{'tail'};
|
||||
return $self->{'items'}->{$self->{'tail'}}->[INSTIME];
|
||||
}
|
||||
|
||||
sub validate_list
|
||||
{
|
||||
my ($self, $source) = @_;
|
||||
print "Validate list: $self->{'size'} (max: $self->{'maxsize'})\n";
|
||||
|
||||
my $count = 1;
|
||||
if ($self->{'size'} && ! defined $self->{'head'}) {
|
||||
die "$source: no head pointer\n";
|
||||
}
|
||||
if ($self->{'size'} && ! defined $self->{'tail'}) {
|
||||
die "$source: no tail pointer\n";
|
||||
}
|
||||
if ($self->{'size'}) {
|
||||
print " head: $self->{'head'}\n";
|
||||
print " tail: $self->{'tail'}\n";
|
||||
}
|
||||
|
||||
my $iter = $self->{'head'};
|
||||
my $last = undef;
|
||||
while ($count <= $self->{'size'}) {
|
||||
if (! defined $iter) {
|
||||
die "$source: undefined iterator\n";
|
||||
}
|
||||
my $item = $self->{'items'}->{$iter};
|
||||
unless (defined $item) {
|
||||
die "$source: item '$iter' isn't in items\n";
|
||||
}
|
||||
my $prevtext = $item->[PREVKEY] || "--";
|
||||
my $nexttext = $item->[NEXTKEY] || "--";
|
||||
print " #$count ($iter): [$prevtext, $item->[VALUE], $nexttext]\n";
|
||||
if ($count == 1 && defined($item->[0])) {
|
||||
die "$source: Head element shouldn't have previous pointer!\n";
|
||||
}
|
||||
if ($count == $self->{'size'} && defined($item->[NEXTKEY])) {
|
||||
die "$source: Last element shouldn't have next pointer!\n";
|
||||
}
|
||||
if (defined $last && ! defined $item->[PREVKEY]) {
|
||||
die "$source: defined \$last but not defined previous pointer.\n";
|
||||
}
|
||||
if (! defined $last && defined $item->[PREVKEY]) {
|
||||
die "$source: not defined \$last but previous pointer defined.\n";
|
||||
}
|
||||
if (defined $item->[PREVKEY] && defined $last && $item->[PREVKEY] ne $last)
|
||||
{
|
||||
die "$source: Previous pointer is wrong.\n";
|
||||
}
|
||||
|
||||
$last = $iter;
|
||||
$iter = defined $item->[NEXTKEY] ? $item->[NEXTKEY] : undef;
|
||||
$count++;
|
||||
}
|
||||
}
|
||||
|
||||
sub drop_tail
|
||||
{
|
||||
my LJ::Cache $self = shift;
|
||||
|
||||
## who's going to die?
|
||||
my $to_die = $self->{'tail'};
|
||||
|
||||
## set the tail to the item before the one dying.
|
||||
$self->{'tail'} = $self->{'items'}->{$to_die}->[PREVKEY];
|
||||
|
||||
## adjust the forward pointer on the tail to be undef
|
||||
if (defined $self->{'tail'}) {
|
||||
undef $self->{'items'}->{$self->{'tail'}}->[NEXTKEY];
|
||||
}
|
||||
|
||||
## kill the item
|
||||
my $bytes = $self->{'items'}->{$to_die}->[BYTES];
|
||||
delete $self->{'items'}->{$to_die};
|
||||
|
||||
## shrink the overall size
|
||||
$self->{'size'}--;
|
||||
$self->{'bytes'} -= $bytes;
|
||||
}
|
||||
|
||||
sub print_list {
|
||||
my LJ::Cache $self = shift;
|
||||
|
||||
print "Size: $self->{'size'} (max: $self->{'maxsize'})\n";
|
||||
|
||||
my $count = 1;
|
||||
my $iter = $self->{'head'};
|
||||
while (defined $iter) { #$count <= $self->{'size'}) {
|
||||
my $item = $self->{'items'}->{$iter};
|
||||
print "$count: $iter = $item->[VALUE]\n";
|
||||
$iter = $item->[NEXTKEY];
|
||||
$count++;
|
||||
}
|
||||
}
|
||||
|
||||
sub get {
|
||||
my LJ::Cache $self = shift;
|
||||
my ($key, $out_flags) = @_;
|
||||
|
||||
if (exists $self->{'items'}->{$key})
|
||||
{
|
||||
my $item = $self->{'items'}->{$key};
|
||||
|
||||
# promote this to the head
|
||||
unless ($self->{'head'} eq $key)
|
||||
{
|
||||
if ($self->{'tail'} eq $key) {
|
||||
$self->{'tail'} = $item->[PREVKEY];
|
||||
}
|
||||
# remove this element from the linked list.
|
||||
my $next = $item->[NEXTKEY];
|
||||
my $prev = $item->[PREVKEY];
|
||||
if (defined $next) { $self->{'items'}->{$next}->[PREVKEY] = $prev; }
|
||||
if (defined $prev) { $self->{'items'}->{$prev}->[NEXTKEY] = $next; }
|
||||
|
||||
# make current head point backwards to this item
|
||||
$self->{'items'}->{$self->{'head'}}->[PREVKEY] = $key;
|
||||
|
||||
# make this item point forwards to current head, and backwards nowhere
|
||||
$item->[NEXTKEY] = $self->{'head'};
|
||||
undef $item->[PREVKEY];
|
||||
|
||||
# make this the new head
|
||||
$self->{'head'} = $key;
|
||||
}
|
||||
|
||||
$$out_flags = $item->[FLAGS] if $out_flags;
|
||||
return $item->[VALUE];
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
# bytes is optional
|
||||
sub set {
|
||||
my LJ::Cache $self = shift;
|
||||
my ($key, $value, $bytes, $flags) = @_;
|
||||
|
||||
$self->drop_tail() while ($self->{'maxsize'} &&
|
||||
$self->{'size'} >= $self->{'maxsize'} &&
|
||||
! exists $self->{'items'}->{$key}) ||
|
||||
($self->{'maxbytes'} && $self->{'size'} &&
|
||||
$self->{'bytes'} + $bytes >= $self->{'maxbytes'} &&
|
||||
! exists $self->{'items'}->{$key});
|
||||
|
||||
|
||||
if (exists $self->{'items'}->{$key}) {
|
||||
# update the value
|
||||
my $it = $self->{'items'}->{$key};
|
||||
$it->[VALUE] = $value;
|
||||
my $bytedelta = $bytes - $it->[BYTES];
|
||||
$self->{'bytes'} += $bytedelta;
|
||||
$it->[BYTES] = $bytes;
|
||||
$it->[FLAGS] = $flags;
|
||||
} else {
|
||||
# stick it at the end, for now
|
||||
my $it = $self->{'items'}->{$key} = [];
|
||||
$it->[PREVKEY] = undef;
|
||||
$it->[NEXTKEY] = undef;
|
||||
$it->[VALUE] = $value;
|
||||
$it->[BYTES] = $bytes;
|
||||
$it->[INSTIME] = time();
|
||||
$it->[FLAGS] = $flags;
|
||||
if ($self->{'size'}) {
|
||||
$self->{'items'}->{$self->{'tail'}}->[NEXTKEY] = $key;
|
||||
$self->{'items'}->{$key}->[PREVKEY] = $self->{'tail'};
|
||||
} else {
|
||||
$self->{'head'} = $key;
|
||||
}
|
||||
$self->{'tail'} = $key;
|
||||
$self->{'size'}++;
|
||||
$self->{'bytes'} += $bytes;
|
||||
}
|
||||
|
||||
# this will promote it to the top:
|
||||
$self->get($key);
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
LJ::Cache - LRU Cache
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use LJ::Cache;
|
||||
my $cache = new LJ::Cache { 'maxsize' => 20 };
|
||||
my $value = $cache->get($key);
|
||||
unless (defined $value) {
|
||||
$val = "load some value";
|
||||
$cache->set($key, $value);
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This class implements an LRU dictionary cache. The two operations on it
|
||||
are get() and set(), both of which promote the key being referenced to
|
||||
the "top" of the cache, so it will stay alive longest.
|
||||
|
||||
When the cache is full and and a new item needs to be added, the oldest
|
||||
one is thrown away.
|
||||
|
||||
You should be able to regenerate the data at any time, if get()
|
||||
returns undef.
|
||||
|
||||
This class is useful for caching information from a slower data source
|
||||
while also keeping a bound on memory usage.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Brad Fitzpatrick, bradfitz@bradfitz.com
|
||||
|
||||
=cut
|
||||
423
livejournal/cgi-bin/LJ/Captcha.pm
Executable file
423
livejournal/cgi-bin/LJ/Captcha.pm
Executable file
@@ -0,0 +1,423 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
package LJ::Captcha;
|
||||
use GD;
|
||||
use File::Temp;
|
||||
use Cwd ();
|
||||
use Digest::MD5 ();
|
||||
use LJ::Blob qw{};
|
||||
require "$ENV{LJHOME}/cgi-bin/ljlib.pl";
|
||||
|
||||
|
||||
# stolen from Authen::Captcha. code was small enough that duplicating
|
||||
# was easier than requiring that module, and removing all its automatic
|
||||
# database tracking stuff and replacing it with ours. maybe we'll move
|
||||
# to using it in the future, but for now this works. (both their code
|
||||
# and ours is GPL)
|
||||
sub generate_visual
|
||||
{
|
||||
my ($code) = @_;
|
||||
|
||||
my $im_width = 25;
|
||||
my $im_height = 35;
|
||||
my $length = length($code);
|
||||
|
||||
my $img = "$LJ::HOME/htdocs/img/captcha";
|
||||
|
||||
# create a new image and color
|
||||
my $im = new GD::Image(($im_width * $length),$im_height);
|
||||
my $black = $im->colorAllocate(0,0,0);
|
||||
|
||||
# copy the character images into the code graphic
|
||||
for(my $i=0; $i < $length; $i++)
|
||||
{
|
||||
my $letter = substr($code,$i,1);
|
||||
my $letter_png = "$img/$letter.png";
|
||||
my $source = new GD::Image($letter_png);
|
||||
$im->copy($source,($i*($im_width),0,0,0,$im_width,$im_height));
|
||||
my $a = int(rand (int(($im_width)/14)))+0;
|
||||
my $b = int(rand (int(($im_height)/12)))+0;
|
||||
my $c = int(rand (int(($im_width)/3)))-(int(($im_width)/5));
|
||||
my $d = int(rand (int(($im_height)/3)))-(int(($im_height)/5));
|
||||
$im->copyResized($source,($i*($im_width))+$a,$b,0,0,($im_width)+$c,($im_height)+$d,$im_width,$im_height);
|
||||
}
|
||||
|
||||
# distort the code graphic
|
||||
for(my $i=0; $i<($length*$im_width*$im_height/14+150); $i++)
|
||||
{
|
||||
my $a = int(rand($length*$im_width));
|
||||
my $b = int(rand($im_height));
|
||||
my $c = int(rand($length*$im_width));
|
||||
my $d = int(rand($im_height));
|
||||
my $index = $im->getPixel($a,$b);
|
||||
if ($i < (($length*($im_width)*($im_height)/14+200)/100))
|
||||
{
|
||||
$im->line($a,$b,$c,$d,$index);
|
||||
} elsif ($i < (($length*($im_width)*($im_height)/14+200)/2)) {
|
||||
$im->setPixel($c,$d,$index);
|
||||
} else {
|
||||
$im->setPixel($c,$d,$black);
|
||||
}
|
||||
}
|
||||
|
||||
# generate a background
|
||||
my $a = int(rand 5)+1;
|
||||
my $background_img = "$img/background$a.png";
|
||||
my $source = new GD::Image($background_img);
|
||||
my ($background_width, $background_height) = $source->getBounds();
|
||||
my $b = int(rand (int($background_width/13)))+0;
|
||||
my $c = int(rand (int($background_height/7)))+0;
|
||||
my $d = int(rand (int($background_width/13)))+0;
|
||||
my $e = int(rand (int($background_height/7)))+0;
|
||||
my $source2 = new GD::Image(($length*($im_width)),$im_height);
|
||||
$source2->copyResized($source,0,0,$b,$c,$length*$im_width,$im_height,$background_width-$b-$d,$background_height-$c-$e);
|
||||
|
||||
# merge the background onto the image
|
||||
$im->copyMerge($source2,0,0,0,0,($length*($im_width)),$im_height,40);
|
||||
|
||||
# add a border
|
||||
$im->rectangle(0, 0, $length*$im_width-1, $im_height-1, $black);
|
||||
|
||||
return $im->png;
|
||||
|
||||
}
|
||||
|
||||
|
||||
### get_visual_id() -> ( $capid, $anum )
|
||||
sub get_visual_id { get_id('image') }
|
||||
sub get_audio_id { get_id('audio') }
|
||||
|
||||
|
||||
### get_id( $type ) -> ( $capid, $anum )
|
||||
sub get_id
|
||||
{
|
||||
my ( $type ) = @_;
|
||||
my (
|
||||
$dbh, # Database handle (writer)
|
||||
$sql, # SQL statement
|
||||
$row, # Row arrayref
|
||||
$capid, # Captcha id
|
||||
$anum, # Unseries-ifier number
|
||||
$issuedate, # unixtime of issue
|
||||
);
|
||||
|
||||
# Fetch database handle and lock the captcha table
|
||||
$dbh = LJ::get_db_writer()
|
||||
or return LJ::error( "Couldn't fetch a db writer." );
|
||||
$dbh->selectrow_array("SELECT GET_LOCK('get_captcha', 10)")
|
||||
or return LJ::error( "Failed lock on getting a captcha." );
|
||||
|
||||
# Fetch the first unassigned row
|
||||
$sql = q{
|
||||
SELECT capid, anum
|
||||
FROM captchas
|
||||
WHERE
|
||||
issuetime = 0
|
||||
AND type = ?
|
||||
LIMIT 1
|
||||
};
|
||||
$row = $dbh->selectrow_arrayref( $sql, undef, $type )
|
||||
or $dbh->do("DO RELEASE_LOCK('get_captcha')") && die "No $type captchas available";
|
||||
die "selectrow_arrayref: $sql: ", $dbh->errstr if $dbh->err;
|
||||
( $capid, $anum ) = @$row;
|
||||
|
||||
# Mark the captcha as issued
|
||||
$issuedate = time();
|
||||
$sql = qq{
|
||||
UPDATE captchas
|
||||
SET issuetime = $issuedate
|
||||
WHERE capid = $capid
|
||||
};
|
||||
$dbh->do( $sql ) or die "do: $sql: ", $dbh->errstr;
|
||||
$dbh->do("DO RELEASE_LOCK('get_captcha')");
|
||||
|
||||
return ( $capid, $anum );
|
||||
}
|
||||
|
||||
|
||||
### get_visual_data( $capid, $anum, $want_paths )
|
||||
# if want_paths is true, this function may return an arrayref containing
|
||||
# one or more paths (disk or HTTP) to the resource
|
||||
sub get_visual_data
|
||||
{
|
||||
my ( $capid, $anum, $want_paths ) = @_;
|
||||
$capid = int($capid);
|
||||
|
||||
my (
|
||||
$dbr, # Database handle (reader)
|
||||
$sql, # SQL statement
|
||||
$valid, # Are the capid/anum valid?
|
||||
$data, # The PNG data
|
||||
$u, # System user
|
||||
$location, # Location of the file (mogile/blob)
|
||||
);
|
||||
|
||||
$dbr = LJ::get_db_reader();
|
||||
$sql = q{
|
||||
SELECT capid, location
|
||||
FROM captchas
|
||||
WHERE
|
||||
capid = ?
|
||||
AND anum = ?
|
||||
};
|
||||
|
||||
( $valid, $location ) = $dbr->selectrow_array( $sql, undef, $capid, $anum );
|
||||
return undef unless $valid;
|
||||
|
||||
if ($location eq 'mogile') {
|
||||
die "MogileFS object not loaded.\n" unless LJ::mogclient();
|
||||
if ($want_paths) {
|
||||
# return path(s) to the content if they want
|
||||
my @paths = LJ::mogclient()->get_paths("captcha:$capid");
|
||||
return \@paths;
|
||||
} else {
|
||||
$data = ${LJ::mogclient()->get_file_data("captcha:$capid")};
|
||||
}
|
||||
} else {
|
||||
$u = LJ::load_user( "system" )
|
||||
or die "Couldn't load the system user.";
|
||||
|
||||
$data = LJ::Blob::get( $u, 'captcha_image', 'png', $capid )
|
||||
or die "Failed to fetch captcha_image $capid from media server";
|
||||
}
|
||||
return $data;
|
||||
}
|
||||
|
||||
|
||||
### get_audio_data( $capid, $anum, $want_paths )
|
||||
# if want_paths is true, this function may return an arrayref containing
|
||||
# one or more paths (disk or HTTP) to the resource
|
||||
sub get_audio_data
|
||||
{
|
||||
my ( $capid, $anum, $want_paths ) = @_;
|
||||
$capid = int($capid);
|
||||
|
||||
my (
|
||||
$dbr, # Database handle (reader)
|
||||
$sql, # SQL statement
|
||||
$valid, # Are the capid/anum valid?
|
||||
$data, # The PNG data
|
||||
$u, # System user
|
||||
$location, # Location of the file (mogile/blob)
|
||||
);
|
||||
|
||||
$dbr = LJ::get_db_reader();
|
||||
$sql = q{
|
||||
SELECT capid, location
|
||||
FROM captchas
|
||||
WHERE
|
||||
capid = ?
|
||||
AND anum = ?
|
||||
};
|
||||
|
||||
( $valid, $location ) = $dbr->selectrow_array( $sql, undef, $capid, $anum );
|
||||
return undef unless $valid;
|
||||
|
||||
if ($location eq 'mogile') {
|
||||
die "MogileFS object not loaded.\n" unless LJ::mogclient();
|
||||
if ($want_paths) {
|
||||
# return path(s) to the content if they want
|
||||
my @paths = LJ::mogclient()->get_paths("captcha:$capid");
|
||||
return \@paths;
|
||||
} else {
|
||||
$data = ${LJ::mogclient()->get_file_data("captcha:$capid")};
|
||||
}
|
||||
} else {
|
||||
$u = LJ::load_user( "system" )
|
||||
or die "Couldn't load the system user.";
|
||||
|
||||
$data = LJ::Blob::get( $u, 'captcha_audio', 'wav', $capid )
|
||||
or die "Failed to fetch captcha_audio $capid from media server";
|
||||
}
|
||||
return $data;
|
||||
}
|
||||
|
||||
|
||||
|
||||
# ($dir) -> ("$dir/speech.wav", $code)
|
||||
# Callers must:
|
||||
# -- create unique temporary directory, shared by no other process
|
||||
# calling this function
|
||||
# -- after return, do something with speech.wav (save on disk server/
|
||||
# db/etc), remove speech.wav, then rmdir $dir
|
||||
# Requires festival and sox.
|
||||
sub generate_audio
|
||||
{
|
||||
my ($dir) = @_;
|
||||
my $old_dir = Cwd::getcwd();
|
||||
chdir($dir) or return 0;
|
||||
|
||||
my $bin_festival = $LJ::BIN_FESTIVAL || "festival";
|
||||
my $bin_sox = $LJ::BIN_SOX || "sox";
|
||||
|
||||
# make up 7 random numbers, without any numbers in a row
|
||||
my @numbers;
|
||||
my $lastnum;
|
||||
for (1..7) {
|
||||
my $num;
|
||||
do {
|
||||
$num = int(rand(9)+1);
|
||||
} while ($num == $lastnum);
|
||||
$lastnum = $num;
|
||||
push @numbers, $num;
|
||||
}
|
||||
my $numbers_speak = join("... ", @numbers);
|
||||
my $numbers_clean = join('', @numbers);
|
||||
|
||||
# generate the clean speech
|
||||
open FEST, '|-', $bin_festival or die "Couldn't invoke festival";
|
||||
print FEST "(Parameter.set 'Audio_Method 'Audio_Command)\n";
|
||||
print FEST "(Parameter.set 'Audio_Required_Format 'wav)\n";
|
||||
print FEST "(Parameter.set 'Audio_Required_Rate 44100)\n";
|
||||
print FEST "(Parameter.set 'Audio_Command \"mv \$FILE speech.wav\")\n";
|
||||
print FEST "(SayText \"$numbers_speak\")\n";
|
||||
close FEST or die "Error closing festival";
|
||||
|
||||
my $sox = sub {
|
||||
my ($effect, $filename, $inopts, $outopts) = @_;
|
||||
$effect = [] unless $effect;
|
||||
$filename = "speech.wav" unless $filename;
|
||||
$inopts = [] unless $inopts;
|
||||
$outopts = [] unless $outopts;
|
||||
command($bin_sox, @$inopts, $filename, @$outopts, "tmp.wav", @$effect);
|
||||
rename('tmp.wav', $filename)
|
||||
or die;
|
||||
};
|
||||
|
||||
# distort the speech
|
||||
$sox->([qw(reverb 0.5 200 100 60 echo 1 0.7 100 0.03 400 0.15)]);
|
||||
command($bin_sox, qw(speech.wav noise.wav synth brownnoise 0 vibro 3 0.8 vol 0.1));
|
||||
$sox->([qw(fade 0.5)], 'noise.wav');
|
||||
$sox->([qw(reverse)], 'noise.wav');
|
||||
$sox->([qw(fade 0.5)], 'noise.wav');
|
||||
|
||||
command("${bin_sox}mix", qw(-v 4 speech.wav noise.wav -r 16000 tmp.wav));
|
||||
rename('tmp.wav', 'speech.wav') or die;
|
||||
unlink('oldspeech.wav', 'noise.wav');
|
||||
|
||||
chdir($old_dir) or return 0;
|
||||
return ("$dir/speech.wav", $numbers_clean);
|
||||
}
|
||||
|
||||
sub command {
|
||||
system(@_) >> 8 == 0 or die "audio command failed, died";
|
||||
}
|
||||
|
||||
|
||||
### check_code( $capid, $anum, $code, $u ) -> <true value if code is correct>
|
||||
sub check_code {
|
||||
my ( $capid, $anum, $code, $u ) = @_;
|
||||
|
||||
my (
|
||||
$dbr, # Database handle (reader)
|
||||
$sql, # SQL query
|
||||
$answer, # Challenge answer
|
||||
$userid, # userid of previous answerer (or 0 if none)
|
||||
);
|
||||
|
||||
$sql = q{
|
||||
SELECT answer, userid
|
||||
FROM captchas
|
||||
WHERE
|
||||
capid = ?
|
||||
AND anum = ?
|
||||
};
|
||||
|
||||
# Fetch the challenge's answer based on id and anum.
|
||||
$dbr = LJ::get_db_writer();
|
||||
( $answer, $userid ) = $dbr->selectrow_array( $sql, undef, $capid, $anum );
|
||||
|
||||
# if it's already been answered, it must have been answered by the $u
|
||||
# given to this function (double-click protection)
|
||||
return 0 if $userid && ( ! $u || $u->{userid} != $userid );
|
||||
|
||||
# otherwise, just check answer.
|
||||
return lc $answer eq lc $code;
|
||||
}
|
||||
|
||||
# Verify captcha answer if using a captcha session.
|
||||
# (captcha challenge, code, $u)
|
||||
# Returns capid and anum if answer correct. (for expire)
|
||||
sub session_check_code {
|
||||
my ($sess, $code, $u) = @_;
|
||||
return 0 unless $sess && $code;
|
||||
$sess = LJ::get_challenge_attributes($sess);
|
||||
|
||||
$u = LJ::load_user('system') unless $u;
|
||||
|
||||
my $dbcm = LJ::get_cluster_master($u);
|
||||
my $dbr = LJ::get_db_reader();
|
||||
|
||||
my ($lcapid, $try) = # clustered
|
||||
$dbcm->selectrow_array('SELECT lastcapid, trynum ' .
|
||||
'FROM captcha_session ' .
|
||||
'WHERE sess=?', undef, $sess);
|
||||
my ($capid, $anum) = # global
|
||||
$dbr->selectrow_array('SELECT capid,anum ' .
|
||||
'FROM captchas '.
|
||||
'WHERE capid=?', undef, $lcapid);
|
||||
if (! LJ::Captcha::check_code($capid, $anum, $code, $u)) {
|
||||
# update try and lastcapid
|
||||
$u->do('UPDATE captcha_session SET lastcapid=NULL, ' .
|
||||
'trynum=trynum+1 WHERE sess=?', undef, $sess);
|
||||
return 0;
|
||||
}
|
||||
return ($capid, $anum);
|
||||
}
|
||||
|
||||
### expire( $capid ) -> <true value if code was expired successfully>
|
||||
sub expire {
|
||||
my ( $capid, $anum, $userid ) = @_;
|
||||
|
||||
my (
|
||||
$dbh, # Database handle (writer)
|
||||
$sql, # SQL update query
|
||||
);
|
||||
|
||||
$sql = q{
|
||||
UPDATE captchas
|
||||
SET userid = ?
|
||||
WHERE capid = ? AND anum = ? AND userid = 0
|
||||
};
|
||||
|
||||
# Fetch the challenge's answer based on id and anum.
|
||||
$dbh = LJ::get_db_writer();
|
||||
$dbh->do( $sql, undef, $userid, $capid, $anum ) or return undef;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Update/create captcha sessions, return new capid/anum pairs on success.
|
||||
# challenge, type, optional journalu->{clusterid} for clustering.
|
||||
# Type is either 'image' or 'audio'
|
||||
sub session
|
||||
{
|
||||
my ($chal, $type, $cid) = @_;
|
||||
return unless $chal && $type;
|
||||
|
||||
my $chalinfo = {};
|
||||
LJ::challenge_check($chal, $chalinfo);
|
||||
return unless $chalinfo->{valid};
|
||||
|
||||
my $sess = LJ::get_challenge_attributes($chal);
|
||||
my ($capid, $anum) = ($type eq 'image') ?
|
||||
LJ::Captcha::get_visual_id() :
|
||||
LJ::Captcha::get_audio_id();
|
||||
|
||||
|
||||
$cid = LJ::load_user('system')->{clusterid} unless $cid;
|
||||
my $dbcm = LJ::get_cluster_master($cid);
|
||||
|
||||
# Retain try count
|
||||
my $try = $dbcm->selectrow_array('SELECT trynum FROM captcha_session ' .
|
||||
'WHERE sess=?', undef, $sess);
|
||||
$try ||= 0;
|
||||
# Add/update session
|
||||
$dbcm->do('REPLACE INTO captcha_session SET sess=?, sesstime=?, '.
|
||||
'lastcapid=?, trynum=?', undef, $sess, time(), $capid, $try);
|
||||
return ($capid, $anum);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
94
livejournal/cgi-bin/LJ/LDAP.pm
Executable file
94
livejournal/cgi-bin/LJ/LDAP.pm
Executable file
@@ -0,0 +1,94 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
package LJ::LDAP;
|
||||
|
||||
use strict;
|
||||
use Net::LDAP;
|
||||
use Digest::MD5 qw(md5);
|
||||
use Digest::SHA1 qw(sha1);
|
||||
use MIME::Base64;
|
||||
|
||||
sub load_ldap_user {
|
||||
my ($user) = @_;
|
||||
return undef unless $user =~ /^[\w ]+$/;
|
||||
|
||||
my $ldap = Net::LDAP->new($LJ::LDAP_HOST)
|
||||
or return undef;
|
||||
my $mesg = $ldap->bind; # an anonymous bind
|
||||
|
||||
my $uid = $LJ::LDAP_UID || "uid";
|
||||
|
||||
my $urec = $ldap->search( # perform a search
|
||||
base => $LJ::LDAP_BASE,
|
||||
scope => "sub",
|
||||
filter => "$uid=$user",
|
||||
#filter => "(&(sn=Barr) (o=Texas Instruments))"
|
||||
)->pop_entry
|
||||
or return undef;
|
||||
|
||||
my $up = $urec->get_value('userPassword')
|
||||
or return undef;
|
||||
|
||||
my ($nick, $email) = ($urec->get_value('gecos'), $urec->get_value('mailLocalAddress'));
|
||||
unless ($nick && $email) {
|
||||
$@ = "Necessary information not found in LDAP record: name=$nick; email=$email";
|
||||
return undef;
|
||||
}
|
||||
|
||||
# $res comes out as...?
|
||||
my $res = {
|
||||
name => $user,
|
||||
nick => $nick,
|
||||
email => $email,
|
||||
ldap_pass => $up,
|
||||
};
|
||||
|
||||
return $res;
|
||||
}
|
||||
|
||||
sub is_good_ldap
|
||||
{
|
||||
my ($user, $pass) = @_;
|
||||
my $lrec = load_ldap_user($user)
|
||||
or return undef;
|
||||
|
||||
# get auth type and data, then decode it
|
||||
return undef unless $lrec->{ldap_pass} =~ /^\{(\w+)\}(.+)$/;
|
||||
my ($auth, $data) = ($1, decode_base64($2));
|
||||
|
||||
if ($auth eq 'MD5') {
|
||||
unless ($data eq md5($pass)) {
|
||||
$@ = "Password mismatch (MD5) from LDAP server; is your password correct?";
|
||||
return undef;
|
||||
}
|
||||
} elsif ($auth eq 'SSHA') {
|
||||
my $salt = substr($data, 20);
|
||||
my $orig = substr($data, 0, 20);
|
||||
unless ($orig eq sha1($pass, $salt)) {
|
||||
$@ = "Password mismatch (SSHA) from LDAP server; is your password correct?";
|
||||
return undef;
|
||||
}
|
||||
|
||||
} elsif ($auth eq 'SMD5') {
|
||||
# this didn't work
|
||||
my $salt = substr($data, 16);
|
||||
my $orig = substr($data, 0, 16);
|
||||
unless ($orig eq md5($pass, $salt)) {
|
||||
$@ = "Password mismatch (SMD5) from LDAP server; is your password correct?";
|
||||
return undef;
|
||||
}
|
||||
|
||||
} else {
|
||||
print STDERR "Unsupported LDAP auth method: $auth\n";
|
||||
$@ = "userPassword field from LDAP server not of supported format; type: $auth"
|
||||
;
|
||||
return undef;
|
||||
}
|
||||
|
||||
return $lrec;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
111
livejournal/cgi-bin/LJ/MemCache.pm
Executable file
111
livejournal/cgi-bin/LJ/MemCache.pm
Executable file
@@ -0,0 +1,111 @@
|
||||
#
|
||||
# Wrapper around MemCachedClient
|
||||
|
||||
use lib "$ENV{'LJHOME'}/cgi-bin";
|
||||
use Cache::Memcached;
|
||||
use strict;
|
||||
|
||||
package LJ::MemCache;
|
||||
|
||||
%LJ::MEMCACHE_ARRAYFMT = (
|
||||
'user' =>
|
||||
[qw[1 userid user caps clusterid dversion email password status statusvis statusvisdate
|
||||
name bdate themeid moodthemeid opt_forcemoodtheme allow_infoshow allow_contactshow
|
||||
allow_getljnews opt_showtalklinks opt_whocanreply opt_gettalkemail opt_htmlemail
|
||||
opt_mangleemail useoverrides defaultpicid has_bio txtmsg_status is_system
|
||||
journaltype lang oldenc]],
|
||||
'fgrp' => [qw[1 userid groupnum groupname sortorder is_public]],
|
||||
# version #101 because old userpic format in memcached was an arrayref of
|
||||
# [width, height, ...] and widths could have been 1 before, although unlikely
|
||||
'userpic' => [qw[101 width height userid fmt state picdate location flags]],
|
||||
);
|
||||
|
||||
|
||||
my $memc; # memcache object
|
||||
|
||||
sub init {
|
||||
$memc = new Cache::Memcached;
|
||||
reload_conf();
|
||||
}
|
||||
|
||||
sub get_memcache {
|
||||
init() unless $memc;
|
||||
return $memc
|
||||
}
|
||||
|
||||
sub client_stats {
|
||||
return $memc->{'stats'} || {};
|
||||
}
|
||||
|
||||
sub reload_conf {
|
||||
my $stat_callback;
|
||||
|
||||
$memc->set_servers(\@LJ::MEMCACHE_SERVERS);
|
||||
$memc->set_debug($LJ::MEMCACHE_DEBUG);
|
||||
$memc->set_pref_ip(\%LJ::MEMCACHE_PREF_IP);
|
||||
$memc->set_compress_threshold($LJ::MEMCACHE_COMPRESS_THRESHOLD);
|
||||
if ($LJ::DB_LOG_HOST) {
|
||||
$stat_callback = sub {
|
||||
my ($stime, $etime, $host, $action) = @_;
|
||||
LJ::blocking_report($host, 'memcache', $etime - $stime, "memcache: $action");
|
||||
};
|
||||
} else {
|
||||
$stat_callback = undef;
|
||||
}
|
||||
$memc->set_stat_callback($stat_callback);
|
||||
$memc->set_readonly(1) if $ENV{LJ_MEMC_READONLY};
|
||||
return $memc;
|
||||
}
|
||||
|
||||
sub forget_dead_hosts { $memc->forget_dead_hosts(); }
|
||||
sub disconnect_all { $memc->disconnect_all(); }
|
||||
|
||||
sub delete {
|
||||
# use delete time if specified
|
||||
return $memc->delete(@_) if defined $_[1];
|
||||
|
||||
# else default to 4 seconds:
|
||||
# version 1.1.7 vs. 1.1.6
|
||||
$memc->delete(@_, 4) || $memc->delete(@_);
|
||||
}
|
||||
|
||||
sub add { $memc->add(@_); }
|
||||
sub replace { $memc->replace(@_); }
|
||||
sub set { $memc->set(@_); }
|
||||
sub get { $memc->get(@_); }
|
||||
sub get_multi { $memc->get_multi(@_); }
|
||||
sub incr { $memc->incr(@_); }
|
||||
sub decr { $memc->decr(@_); }
|
||||
|
||||
sub _get_sock { $memc->get_sock(@_); }
|
||||
|
||||
sub run_command { $memc->run_command(@_); }
|
||||
|
||||
|
||||
sub array_to_hash {
|
||||
my ($fmtname, $ar) = @_;
|
||||
my $fmt = $LJ::MEMCACHE_ARRAYFMT{$fmtname};
|
||||
return undef unless $fmt;
|
||||
return undef unless $ar && ref $ar eq "ARRAY" && $ar->[0] == $fmt->[0];
|
||||
my $hash = {};
|
||||
my $ct = scalar(@$fmt);
|
||||
for (my $i=1; $i<$ct; $i++) {
|
||||
$hash->{$fmt->[$i]} = $ar->[$i];
|
||||
}
|
||||
return $hash;
|
||||
}
|
||||
|
||||
sub hash_to_array {
|
||||
my ($fmtname, $hash) = @_;
|
||||
my $fmt = $LJ::MEMCACHE_ARRAYFMT{$fmtname};
|
||||
return undef unless $fmt;
|
||||
return undef unless $hash && ref $hash;
|
||||
my $ar = [$fmt->[0]];
|
||||
my $ct = scalar(@$fmt);
|
||||
for (my $i=1; $i<$ct; $i++) {
|
||||
$ar->[$i] = $hash->{$fmt->[$i]};
|
||||
}
|
||||
return $ar;
|
||||
}
|
||||
|
||||
1;
|
||||
189
livejournal/cgi-bin/LJ/OpenID.pm
Executable file
189
livejournal/cgi-bin/LJ/OpenID.pm
Executable file
@@ -0,0 +1,189 @@
|
||||
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(
|
||||
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() },
|
||||
debug => $LJ::IS_DEV_SERVER || 0,
|
||||
);
|
||||
|
||||
return $csr;
|
||||
}
|
||||
|
||||
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;
|
||||
|
||||
if ($duration eq "once") {
|
||||
$dbh->do("DELETE FROM openid_trust WHERE userid=? AND endpoint_id=?", undef, $u->{userid}, $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/";
|
||||
|
||||
if ($get->{'ljuser_sha1'} eq sha1_hex($user) ||
|
||||
$get->{'ljuser'} eq $user) {
|
||||
my $dbh = LJ::get_db_writer();
|
||||
return $dbh->selectrow_array("SELECT COUNT(*) FROM openid_external WHERE userid=? AND url=?",
|
||||
undef, $u->{userid}, $ident);
|
||||
}
|
||||
|
||||
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, $dur) = @_;
|
||||
|
||||
return 0 unless $dur =~ /^always|once$/;
|
||||
|
||||
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, $dur);
|
||||
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;
|
||||
# NEEDS TO BE NOT HARDCODED
|
||||
if ($dest =~ /livejournal\.com$/i) {
|
||||
$tried_local_id = 1;
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
});
|
||||
return \$tried_local_id;
|
||||
}
|
||||
|
||||
1;
|
||||
2669
livejournal/cgi-bin/LJ/S2.pm
Executable file
2669
livejournal/cgi-bin/LJ/S2.pm
Executable file
File diff suppressed because it is too large
Load Diff
239
livejournal/cgi-bin/LJ/S2/DayPage.pm
Executable file
239
livejournal/cgi-bin/LJ/S2/DayPage.pm
Executable file
@@ -0,0 +1,239 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
use strict;
|
||||
package LJ::S2;
|
||||
|
||||
sub DayPage
|
||||
{
|
||||
my ($u, $remote, $opts) = @_;
|
||||
|
||||
my $p = Page($u, $opts);
|
||||
$p->{'_type'} = "DayPage";
|
||||
$p->{'view'} = "day";
|
||||
$p->{'entries'} = [];
|
||||
|
||||
my $user = $u->{'user'};
|
||||
my $journalbase = LJ::journal_base($user, $opts->{'vhost'});
|
||||
|
||||
if ($u->{'journaltype'} eq "R" && $u->{'renamedto'} ne "") {
|
||||
$opts->{'redir'} = LJ::journal_base($u->{'renamedto'}, $opts->{'vhost'}) .
|
||||
"/calendar" . $opts->{'pathextra'};
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ($u->{'opt_blockrobots'}) {
|
||||
$p->{'head_content'} .= LJ::robot_meta_tags();
|
||||
}
|
||||
|
||||
my $get = $opts->{'getargs'};
|
||||
|
||||
my $month = $get->{'month'};
|
||||
my $day = $get->{'day'};
|
||||
my $year = $get->{'year'};
|
||||
my @errors = ();
|
||||
|
||||
if ($opts->{'pathextra'} =~ m!^/(\d\d\d\d)/(\d\d)/(\d\d)\b!) {
|
||||
($month, $day, $year) = ($2, $3, $1);
|
||||
}
|
||||
|
||||
$opts->{'errors'} = [];
|
||||
if ($year !~ /^\d+$/) { push @{$opts->{'errors'}}, "Corrupt or non-existant year."; }
|
||||
if ($month !~ /^\d+$/) { push @{$opts->{'errors'}}, "Corrupt or non-existant month."; }
|
||||
if ($day !~ /^\d+$/) { push @{$opts->{'errors'}}, "Corrupt or non-existant day."; }
|
||||
if ($month < 1 || $month > 12 || int($month) != $month) { push @{$opts->{'errors'}}, "Invalid month."; }
|
||||
if ($year < 1970 || $year > 2038 || int($year) != $year) { push @{$opts->{'errors'}}, "Invalid year: $year"; }
|
||||
if ($day < 1 || $day > 31 || int($day) != $day) { push @{$opts->{'errors'}}, "Invalid day."; }
|
||||
if (scalar(@{$opts->{'errors'}})==0 && $day > LJ::days_in_month($month, $year)) { push @{$opts->{'errors'}}, "That month doesn't have that many days."; }
|
||||
return if @{$opts->{'errors'}};
|
||||
|
||||
$p->{'date'} = Date($year, $month, $day);
|
||||
|
||||
my $secwhere = "AND security='public'";
|
||||
my $viewall = 0;
|
||||
my $viewsome = 0; # see public posts from suspended users
|
||||
if ($remote) {
|
||||
|
||||
# do they have the viewall priv?
|
||||
if ($get->{'viewall'} && LJ::check_priv($remote, "canview")) {
|
||||
LJ::statushistory_add($u->{'userid'}, $remote->{'userid'},
|
||||
"viewall", "day: $user, statusvis: $u->{'statusvis'}");
|
||||
$viewall = LJ::check_priv($remote, 'canview', '*');
|
||||
$viewsome = $viewall || LJ::check_priv($remote, 'canview', 'suspended');
|
||||
}
|
||||
|
||||
if ($remote->{'userid'} == $u->{'userid'} || $viewall) {
|
||||
$secwhere = ""; # see everything
|
||||
} elsif ($remote->{'journaltype'} eq 'P') {
|
||||
my $gmask = LJ::get_groupmask($u, $remote);
|
||||
$secwhere = "AND (security='public' OR (security='usemask' AND allowmask & $gmask))"
|
||||
if $gmask;
|
||||
}
|
||||
}
|
||||
|
||||
my $dbcr = LJ::get_cluster_reader($u);
|
||||
unless ($dbcr) {
|
||||
push @{$opts->{'errors'}}, "Database temporarily unavailable";
|
||||
return;
|
||||
}
|
||||
|
||||
# load the log items
|
||||
my $dateformat = "%Y %m %d %H %i %s %w"; # yyyy mm dd hh mm ss day_of_week
|
||||
my $sth = $dbcr->prepare("SELECT jitemid AS itemid, posterid, security, DATE_FORMAT(eventtime, \"$dateformat\") AS 'alldatepart', anum ".
|
||||
"FROM log2 " .
|
||||
"WHERE journalid=$u->{'userid'} AND year=$year AND month=$month AND day=$day $secwhere " .
|
||||
"ORDER BY eventtime, logtime LIMIT 200");
|
||||
$sth->execute;
|
||||
|
||||
my @items;
|
||||
push @items, $_ while $_ = $sth->fetchrow_hashref;
|
||||
my @itemids = map { $_->{'itemid'} } @items;
|
||||
|
||||
# load 'opt_ljcut_disable_lastn' prop for $remote.
|
||||
LJ::load_user_props($remote, "opt_ljcut_disable_lastn");
|
||||
|
||||
### load the log properties
|
||||
my %logprops = ();
|
||||
my $logtext;
|
||||
LJ::load_log_props2($dbcr, $u->{'userid'}, \@itemids, \%logprops);
|
||||
$logtext = LJ::get_logtext2($u, @itemids);
|
||||
|
||||
my (%apu, %apu_lite); # alt poster users; UserLite objects
|
||||
foreach (@items) {
|
||||
next unless $_->{'posterid'} != $u->{'userid'};
|
||||
$apu{$_->{'posterid'}} = undef;
|
||||
}
|
||||
if (%apu) {
|
||||
LJ::load_userids_multiple([map { $_, \$apu{$_} } keys %apu], [$u]);
|
||||
$apu_lite{$_} = UserLite($apu{$_}) foreach keys %apu;
|
||||
}
|
||||
|
||||
# load tags
|
||||
my $tags = LJ::Tags::get_logtags($u, \@itemids);
|
||||
|
||||
my $userlite_journal = UserLite($u);
|
||||
|
||||
ENTRY:
|
||||
foreach my $item (@items)
|
||||
{
|
||||
my ($posterid, $itemid, $security, $alldatepart, $anum) =
|
||||
map { $item->{$_} } qw(posterid itemid security alldatepart anum);
|
||||
|
||||
my $replycount = $logprops{$itemid}->{'replycount'};
|
||||
my $subject = $logtext->{$itemid}->[0];
|
||||
my $text = $logtext->{$itemid}->[1];
|
||||
if ($get->{'nohtml'}) {
|
||||
# quote all non-LJ tags
|
||||
$subject =~ s{<(?!/?lj)(.*?)>} {<$1>}gi;
|
||||
$text =~ s{<(?!/?lj)(.*?)>} {<$1>}gi;
|
||||
}
|
||||
|
||||
# don't show posts from suspended users
|
||||
next ENTRY if $apu{$posterid} && $apu{$posterid}->{'statusvis'} eq 'S' && ! $viewsome;
|
||||
|
||||
if ($LJ::UNICODE && $logprops{$itemid}->{'unknown8bit'}) {
|
||||
LJ::item_toutf8($u, \$subject, \$text, $logprops{$itemid});
|
||||
}
|
||||
|
||||
LJ::CleanHTML::clean_subject(\$subject) if $subject;
|
||||
|
||||
my $ditemid = $itemid*256 + $anum;
|
||||
|
||||
LJ::CleanHTML::clean_event(\$text, { 'preformatted' => $logprops{$itemid}->{'opt_preformatted'},
|
||||
'cuturl' => LJ::item_link($u, $itemid, $anum),
|
||||
'ljcut_disable' => $remote->{'opt_ljcut_disable_lastn'}, });
|
||||
LJ::expand_embedded($u, $ditemid, $remote, \$text);
|
||||
|
||||
my $nc = "";
|
||||
$nc .= "nc=$replycount" if $replycount && $remote && $remote->{'opt_nctalklinks'};
|
||||
|
||||
my $permalink = "$journalbase/$ditemid.html";
|
||||
my $readurl = $permalink;
|
||||
$readurl .= "?$nc" if $nc;
|
||||
my $posturl = $permalink . "?mode=reply";
|
||||
|
||||
my $comments = CommentInfo({
|
||||
'read_url' => $readurl,
|
||||
'post_url' => $posturl,
|
||||
'count' => $replycount,
|
||||
'maxcomments' => ($replycount >= LJ::get_cap($u, 'maxcomments')) ? 1 : 0,
|
||||
'enabled' => ($u->{'opt_showtalklinks'} eq "Y" && ! $logprops{$itemid}->{'opt_nocomments'}) ? 1 : 0,
|
||||
'screened' => ($logprops{$itemid}->{'hasscreened'} && $remote &&
|
||||
($remote->{'user'} eq $u->{'user'} || LJ::can_manage($remote, $u))) ? 1 : 0,
|
||||
});
|
||||
|
||||
my $userlite_poster = $userlite_journal;
|
||||
my $pu = $u;
|
||||
if ($u->{'userid'} != $posterid) {
|
||||
$userlite_poster = $apu_lite{$posterid} or die "No apu_lite for posterid=$posterid";
|
||||
$pu = $apu{$posterid};
|
||||
}
|
||||
my $userpic = Image_userpic($pu, 0, $logprops{$itemid}->{'picture_keyword'});
|
||||
|
||||
my @taglist;
|
||||
while (my ($kwid, $kw) = each %{$tags->{$itemid} || {}}) {
|
||||
push @taglist, Tag($u, $kwid => $kw);
|
||||
}
|
||||
@taglist = sort { $a->{name} cmp $b->{name} } @taglist;
|
||||
|
||||
if ($opts->{enable_tags_compatibility} && @taglist) {
|
||||
$text .= LJ::S2::get_tags_text($opts->{ctx}, \@taglist);
|
||||
}
|
||||
|
||||
my $entry = Entry($u, {
|
||||
'subject' => $subject,
|
||||
'text' => $text,
|
||||
'dateparts' => $alldatepart,
|
||||
'security' => $security,
|
||||
'props' => $logprops{$itemid},
|
||||
'itemid' => $ditemid,
|
||||
'journal' => $userlite_journal,
|
||||
'poster' => $userlite_poster,
|
||||
'comments' => $comments,
|
||||
'tags' => \@taglist,
|
||||
'userpic' => $userpic,
|
||||
'permalink_url' => $permalink,
|
||||
});
|
||||
|
||||
push @{$p->{'entries'}}, $entry;
|
||||
}
|
||||
|
||||
if (@{$p->{'entries'}}) {
|
||||
$p->{'has_entries'} = 1;
|
||||
$p->{'entries'}->[0]->{'new_day'} = 1;
|
||||
$p->{'entries'}->[-1]->{'end_day'} = 1;
|
||||
}
|
||||
|
||||
# calculate previous day
|
||||
my $pdyear = $year;
|
||||
my $pdmonth = $month;
|
||||
my $pdday = $day-1;
|
||||
if ($pdday < 1)
|
||||
{
|
||||
if (--$pdmonth < 1)
|
||||
{
|
||||
$pdmonth = 12;
|
||||
$pdyear--;
|
||||
}
|
||||
$pdday = LJ::days_in_month($pdmonth, $pdyear);
|
||||
}
|
||||
|
||||
# calculate next day
|
||||
my $nxyear = $year;
|
||||
my $nxmonth = $month;
|
||||
my $nxday = $day+1;
|
||||
if ($nxday > LJ::days_in_month($nxmonth, $nxyear))
|
||||
{
|
||||
$nxday = 1;
|
||||
if (++$nxmonth > 12) { ++$nxyear; $nxmonth=1; }
|
||||
}
|
||||
|
||||
$p->{'prev_url'} = "$u->{'_journalbase'}/" . sprintf("%04d/%02d/%02d/", $pdyear, $pdmonth, $pdday);
|
||||
$p->{'prev_date'} = Date($pdyear, $pdmonth, $pdday);
|
||||
$p->{'next_url'} = "$u->{'_journalbase'}/" . sprintf("%04d/%02d/%02d/", $nxyear, $nxmonth, $nxday);
|
||||
$p->{'next_date'} = Date($nxyear, $nxmonth, $nxday);
|
||||
|
||||
return $p;
|
||||
}
|
||||
|
||||
1;
|
||||
377
livejournal/cgi-bin/LJ/S2/EntryPage.pm
Executable file
377
livejournal/cgi-bin/LJ/S2/EntryPage.pm
Executable file
@@ -0,0 +1,377 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
use strict;
|
||||
package LJ::S2;
|
||||
|
||||
sub EntryPage
|
||||
{
|
||||
my ($u, $remote, $opts) = @_;
|
||||
|
||||
my $get = $opts->{'getargs'};
|
||||
|
||||
my $p = Page($u, $opts);
|
||||
$p->{'_type'} = "EntryPage";
|
||||
$p->{'view'} = "entry";
|
||||
$p->{'comment_pages'} = undef;
|
||||
$p->{'comments'} = [];
|
||||
$p->{'comment_pages'} = undef;
|
||||
|
||||
# setup viewall options
|
||||
my ($viewall, $viewsome) = (0, 0);
|
||||
if ($get->{viewall} && LJ::check_priv($remote, 'canview')) {
|
||||
# we don't log here, as we don't know what entry we're viewing yet. the logging
|
||||
# is done when we call EntryPage_entry below.
|
||||
$viewall = LJ::check_priv($remote, 'canview', '*');
|
||||
$viewsome = $viewall || LJ::check_priv($remote, 'canview', 'suspended');
|
||||
}
|
||||
|
||||
my ($entry, $s2entry) = EntryPage_entry($u, $remote, $opts);
|
||||
return if $opts->{'suspendeduser'};
|
||||
return if $opts->{'handler_return'};
|
||||
|
||||
$p->{'multiform_on'} = $remote &&
|
||||
($remote->{'userid'} == $u->{'userid'} ||
|
||||
$remote->{'userid'} == $entry->{'posterid'} ||
|
||||
LJ::can_manage($remote, $u));
|
||||
|
||||
my $itemid = $entry->{'itemid'};
|
||||
my $ditemid = $entry->{'itemid'} * 256 + $entry->{'anum'};
|
||||
my $permalink = LJ::journal_base($u) . "/$ditemid.html";
|
||||
my $stylemine = $get->{'style'} eq "mine" ? "style=mine" : "";
|
||||
|
||||
if ($u->{'journaltype'} eq "R" && $u->{'renamedto'} ne "") {
|
||||
$opts->{'redir'} = LJ::journal_base($u->{'renamedto'}, $opts->{'vhost'}) .
|
||||
"/$ditemid.html" . $opts->{'pathextra'};
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ($u->{'opt_blockrobots'}) {
|
||||
$p->{'head_content'} .= LJ::robot_meta_tags();
|
||||
}
|
||||
if ($LJ::UNICODE) {
|
||||
$p->{'head_content'} .= '<meta http-equiv="Content-Type" content="text/html; charset='.$opts->{'saycharset'}."\" />\n";
|
||||
}
|
||||
|
||||
$p->{'entry'} = $s2entry;
|
||||
|
||||
# add the comments
|
||||
my %userpic;
|
||||
my %user;
|
||||
my $copts = {
|
||||
'thread' => ($get->{'thread'} >> 8),
|
||||
'page' => $get->{'page'},
|
||||
'view' => $get->{'view'},
|
||||
'userpicref' => \%userpic,
|
||||
'userref' => \%user,
|
||||
# user object is cached from call just made in EntryPage_entry
|
||||
'up' => LJ::load_user($s2entry->{'poster'}->{'username'}),
|
||||
'viewall' => $viewall,
|
||||
};
|
||||
|
||||
my $userlite_journal = UserLite($u);
|
||||
|
||||
my @comments = LJ::Talk::load_comments($u, $remote, "L", $itemid, $copts);
|
||||
|
||||
my $pics = LJ::Talk::get_subjecticons()->{'pic'}; # hashref of imgname => { w, h, img }
|
||||
my $convert_comments = sub {
|
||||
my ($self, $destlist, $srclist, $depth) = @_;
|
||||
|
||||
foreach my $com (@$srclist) {
|
||||
my $dtalkid = $com->{'talkid'} * 256 + $entry->{'anum'};
|
||||
my $text = $com->{'body'};
|
||||
if ($get->{'nohtml'}) {
|
||||
# quote all non-LJ tags
|
||||
$text =~ s{<(?!/?lj)(.*?)>} {<$1>}gi;
|
||||
}
|
||||
LJ::CleanHTML::clean_comment(\$text, { 'preformatted' => $com->{'props'}->{'opt_preformatted'},
|
||||
'anon_comment' => !$com->{posterid}});
|
||||
|
||||
# local time in mysql format to gmtime
|
||||
my $datetime = DateTime_unix(LJ::mysqldate_to_time($com->{'datepost'}));
|
||||
|
||||
my $subject_icon = undef;
|
||||
if (my $si = $com->{'props'}->{'subjecticon'}) {
|
||||
my $pic = $pics->{$si};
|
||||
$subject_icon = Image("$LJ::IMGPREFIX/talk/$pic->{'img'}",
|
||||
$pic->{'w'}, $pic->{'h'}) if $pic;
|
||||
}
|
||||
|
||||
my $comment_userpic;
|
||||
if (my $pic = $userpic{$com->{'picid'}}) {
|
||||
$comment_userpic = Image("$LJ::USERPIC_ROOT/$com->{'picid'}/$pic->{'userid'}",
|
||||
$pic->{'width'}, $pic->{'height'});
|
||||
}
|
||||
|
||||
my $reply_url = LJ::Talk::talkargs($permalink, "replyto=$dtalkid", $stylemine);
|
||||
|
||||
my $par_url;
|
||||
if ($com->{'parenttalkid'}) {
|
||||
my $dparent = ($com->{'parenttalkid'} << 8) + $entry->{'anum'};
|
||||
$par_url = LJ::Talk::talkargs($permalink, "thread=$dparent", $stylemine) . "#t$dparent";
|
||||
}
|
||||
|
||||
my $poster;
|
||||
if ($com->{'posterid'}) {
|
||||
if ($user{$com->{'posterid'}}) {
|
||||
$poster = UserLite($user{$com->{'posterid'}});
|
||||
} else {
|
||||
$poster = {
|
||||
'_type' => 'UserLite',
|
||||
'username' => $com->{'userpost'},
|
||||
'name' => $com->{'userpost'}, # we don't have this, so fake it
|
||||
'journal_type' => 'P', # fake too, but only people can post, so correct
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
my $s2com = {
|
||||
'_type' => 'Comment',
|
||||
'journal' => $userlite_journal,
|
||||
'metadata' => {
|
||||
'picture_keyword' => $com->{'props'}->{'picture_keyword'},
|
||||
},
|
||||
'permalink_url' => "$permalink?thread=$dtalkid#t$dtalkid",
|
||||
'reply_url' => $reply_url,
|
||||
'poster' => $poster,
|
||||
'replies' => [],
|
||||
'subject' => LJ::ehtml($com->{'subject'}),
|
||||
'subject_icon' => $subject_icon,
|
||||
'talkid' => $dtalkid,
|
||||
'text' => $text,
|
||||
'userpic' => $comment_userpic,
|
||||
'time' => $datetime,
|
||||
'tags' => [],
|
||||
'full' => $com->{'_loaded'} ? 1 : 0,
|
||||
'depth' => $depth,
|
||||
'parent_url' => $par_url,
|
||||
'screened' => $com->{'state'} eq "S" ? 1 : 0,
|
||||
'frozen' => $com->{'state'} eq "F" ? 1 : 0,
|
||||
'link_keyseq' => [ 'delete_comment' ],
|
||||
'anchor' => "t$dtalkid",
|
||||
'dom_id' => "ljcmt$dtalkid",
|
||||
};
|
||||
|
||||
# don't show info from suspended users
|
||||
# FIXME: ideally the load_comments should only return these
|
||||
# items if there are children, otherwise they should be hidden entirely
|
||||
my $pu = $com->{'posterid'} ? $user{$com->{'posterid'}} : undef;
|
||||
if ($pu && $pu->{'statusvis'} eq "S" && !$viewsome) {
|
||||
$s2com->{'text'} = "";
|
||||
$s2com->{'subject'} = "";
|
||||
$s2com->{'full'} = 0;
|
||||
$s2com->{'subject_icon'} = undef;
|
||||
$s2com->{'userpic'} = undef;
|
||||
}
|
||||
|
||||
# Conditionally add more links to the keyseq
|
||||
my $link_keyseq = $s2com->{'link_keyseq'};
|
||||
push @$link_keyseq, $s2com->{'screened'} ? 'unscreen_comment' : 'screen_comment';
|
||||
push @$link_keyseq, $s2com->{'frozen'} ? 'unfreeze_thread' : 'freeze_thread';
|
||||
|
||||
if (@{$com->{'children'}}) {
|
||||
$s2com->{'thread_url'} = LJ::Talk::talkargs($permalink, "thread=$dtalkid", $stylemine) . "#t$dtalkid";
|
||||
}
|
||||
|
||||
# add the poster_ip metadata if remote user has
|
||||
# access to see it.
|
||||
$s2com->{'metadata'}->{'poster_ip'} = $com->{'props'}->{'poster_ip'} if
|
||||
($com->{'props'}->{'poster_ip'} && $remote &&
|
||||
($remote->{'userid'} == $entry->{'posterid'} ||
|
||||
LJ::can_manage($remote, $u) || $viewall));
|
||||
|
||||
push @$destlist, $s2com;
|
||||
|
||||
$self->($self, $s2com->{'replies'}, $com->{'children'}, $depth+1);
|
||||
}
|
||||
};
|
||||
$p->{'comments'} = [];
|
||||
$convert_comments->($convert_comments, $p->{'comments'}, \@comments, 1);
|
||||
|
||||
# prepare the javascript data structure to put in the top of the page
|
||||
# if the remote user is a manager of the comments
|
||||
my $do_commentmanage_js = $p->{'multiform_on'};
|
||||
if ($LJ::DISABLED{'commentmanage'}) {
|
||||
if (ref $LJ::DISABLED{'commentmanage'} eq "CODE") {
|
||||
$do_commentmanage_js = $LJ::DISABLED{'commentmanage'}->($remote);
|
||||
} else {
|
||||
$do_commentmanage_js = 0;
|
||||
}
|
||||
}
|
||||
|
||||
if ($do_commentmanage_js) {
|
||||
my $js = "<script>\n// don't crawl this. read http://www.livejournal.com/developer/exporting.bml\n";
|
||||
$js .= "var LJ_cmtinfo = {\n";
|
||||
my $canAdmin = LJ::can_manage($remote, $u) ? 1 : 0;
|
||||
$js .= "\tjournal: '$u->{user}',\n";
|
||||
$js .= "\tcanAdmin: $canAdmin,\n";
|
||||
$js .= "\tremote: '$remote->{user}',\n" if $remote;
|
||||
my $recurse = sub {
|
||||
my ($self, $array) = @_;
|
||||
foreach my $i (@$array) {
|
||||
my $has_threads = scalar @{$i->{'replies'}};
|
||||
my $poster = $i->{'poster'} ? $i->{'poster'}{'username'} : "";
|
||||
my $child_ids = join(',', map { $_->{'talkid'} } @{$i->{'replies'}});
|
||||
$js .= "\t$i->{'talkid'}: { rc: [$child_ids], u: '$poster' },\n";
|
||||
$self->($self, $i->{'replies'}) if $has_threads;
|
||||
}
|
||||
};
|
||||
$recurse->($recurse, $p->{'comments'});
|
||||
chop $js; chop $js; # remove final ",\n". stupid javascript.
|
||||
$js .= "\n};\n" .
|
||||
"var LJVAR;\n".
|
||||
"if (!LJVAR) LJVAR = new Object();\n".
|
||||
"LJVAR.imgprefix = \"$LJ::IMGPREFIX\";\n".
|
||||
"</script>\n";
|
||||
$p->{'head_content'} .= $js;
|
||||
$p->{'head_content'} .= "<script src='$LJ::SITEROOT/js/commentmanage.js'></script>\n";
|
||||
|
||||
}
|
||||
|
||||
|
||||
$p->{'viewing_thread'} = $get->{'thread'} ? 1 : 0;
|
||||
|
||||
# default values if there were no comments, because
|
||||
# LJ::Talk::load_comments() doesn't provide them.
|
||||
if ($copts->{'out_error'} eq 'noposts') {
|
||||
$copts->{'out_pages'} = $copts->{'out_page'} = 1;
|
||||
$copts->{'out_items'} = 0;
|
||||
$copts->{'out_itemfirst'} = $copts->{'out_itemlast'} = undef;
|
||||
}
|
||||
|
||||
$p->{'comment_pages'} = ItemRange({
|
||||
'all_subitems_displayed' => ($copts->{'out_pages'} == 1),
|
||||
'current' => $copts->{'out_page'},
|
||||
'from_subitem' => $copts->{'out_itemfirst'},
|
||||
'num_subitems_displayed' => scalar @comments,
|
||||
'to_subitem' => $copts->{'out_itemlast'},
|
||||
'total' => $copts->{'out_pages'},
|
||||
'total_subitems' => $copts->{'out_items'},
|
||||
'_url_of' => sub { return "$permalink?page=" . int($_[0]) .
|
||||
($stylemine ? "&$stylemine" : ''); },
|
||||
});
|
||||
|
||||
return $p;
|
||||
}
|
||||
|
||||
sub EntryPage_entry
|
||||
{
|
||||
my ($u, $remote, $opts) = @_;
|
||||
|
||||
my $get = $opts->{'getargs'};
|
||||
|
||||
my $r = $opts->{'r'};
|
||||
my $uri = $r->uri;
|
||||
|
||||
my ($ditemid, $itemid, $anum);
|
||||
unless ($uri =~ /(\d+)\.html/) {
|
||||
$opts->{'handler_return'} = 404;
|
||||
return;
|
||||
}
|
||||
|
||||
$ditemid = $1;
|
||||
$anum = $ditemid % 256;
|
||||
$itemid = $ditemid >> 8;
|
||||
|
||||
my $entry = LJ::Talk::get_journal_item($u, $itemid);
|
||||
unless ($entry && $entry->{'anum'} == $anum) {
|
||||
$opts->{'handler_return'} = 404;
|
||||
return;
|
||||
}
|
||||
|
||||
my $userlite_journal = UserLite($u);
|
||||
my $userlite_poster = $userlite_journal;
|
||||
my $pu = $u;
|
||||
if ($entry->{'posterid'} != $entry->{'ownerid'}) {
|
||||
$pu = LJ::load_userid($entry->{'posterid'});
|
||||
$userlite_poster = UserLite($pu);
|
||||
}
|
||||
|
||||
# do they have the viewall priv?
|
||||
my $viewall = 0;
|
||||
my $viewsome = 0;
|
||||
if ($get->{'viewall'} && LJ::check_priv($remote, "canview")) {
|
||||
LJ::statushistory_add($u->{'userid'}, $remote->{'userid'},
|
||||
"viewall", "entry: $u->{'user'}, itemid: $itemid, statusvis: $u->{'statusvis'}");
|
||||
$viewall = LJ::check_priv($remote, 'canview', '*');
|
||||
$viewsome = $viewall || LJ::check_priv($remote, 'canview', 'suspended');
|
||||
}
|
||||
|
||||
# check using normal rules
|
||||
unless (LJ::can_view($remote, $entry) || $viewall) {
|
||||
$opts->{'handler_return'} = 403;
|
||||
return;
|
||||
}
|
||||
if (($pu && $pu->{'statusvis'} eq 'S') && !$viewsome) {
|
||||
$opts->{'suspendeduser'} = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
my $replycount = $entry->{'props'}->{'replycount'};
|
||||
my $nc = "";
|
||||
$nc .= "nc=$replycount" if $replycount && $remote && $remote->{'opt_nctalklinks'};
|
||||
|
||||
my $stylemine = $get->{'style'} eq "mine" ? "style=mine" : "";
|
||||
|
||||
my $userpic = Image_userpic($pu, 0, $entry->{'props'}->{'picture_keyword'});
|
||||
|
||||
my $permalink = LJ::journal_base($u) . "/$ditemid.html";
|
||||
my $readurl = LJ::Talk::talkargs($permalink, $nc, $stylemine);
|
||||
my $posturl = LJ::Talk::talkargs($permalink, "mode=reply", $stylemine);
|
||||
|
||||
my $comments = CommentInfo({
|
||||
'read_url' => $readurl,
|
||||
'post_url' => $posturl,
|
||||
'count' => $replycount,
|
||||
'maxcomments' => ($replycount >= LJ::get_cap($u, 'maxcomments')) ? 1 : 0,
|
||||
'enabled' => ($u->{'opt_showtalklinks'} eq "Y" && !
|
||||
$entry->{'props'}->{'opt_nocomments'}) ? 1 : 0,
|
||||
'screened' => ($entry->{'props'}->{'hasscreened'} && $remote &&
|
||||
($remote->{'user'} eq $u->{'user'} || LJ::can_manage($remote, $u))) ? 1 : 0,
|
||||
});
|
||||
|
||||
# format it
|
||||
if ($opts->{'getargs'}->{'nohtml'}) {
|
||||
# quote all non-LJ tags
|
||||
$entry->{'subject'} =~ s{<(?!/?lj)(.*?)>} {<$1>}gi;
|
||||
$entry->{'event'} =~ s{<(?!/?lj)(.*?)>} {<$1>}gi;
|
||||
}
|
||||
my $raw_subj = $entry->{'subject'};
|
||||
LJ::CleanHTML::clean_subject(\$entry->{'subject'});
|
||||
LJ::CleanHTML::clean_event(\$entry->{'event'}, $entry->{'props'}->{'opt_preformatted'});
|
||||
LJ::expand_embedded($u, $ditemid, $remote, \$entry->{'event'});
|
||||
|
||||
# load tags
|
||||
my @taglist;
|
||||
my $tags = LJ::Tags::get_logtags($u, $itemid);
|
||||
while (my ($kwid, $kw) = each %{$tags->{$itemid} || {}}) {
|
||||
push @taglist, Tag($u, $kwid => $kw);
|
||||
}
|
||||
@taglist = sort { $a->{name} cmp $b->{name} } @taglist;
|
||||
|
||||
if ($opts->{enable_tags_compatibility} && @taglist) {
|
||||
$entry->{event} .= LJ::S2::get_tags_text($opts->{ctx}, \@taglist);
|
||||
}
|
||||
|
||||
my $s2entry = Entry($u, {
|
||||
'_rawsubject' => $raw_subj,
|
||||
'subject' => $entry->{'subject'},
|
||||
'text' => $entry->{'event'},
|
||||
'dateparts' => $entry->{'alldatepart'},
|
||||
'security' => $entry->{'security'},
|
||||
'props' => $entry->{'props'},
|
||||
'itemid' => $ditemid,
|
||||
'comments' => $comments,
|
||||
'journal' => $userlite_journal,
|
||||
'poster' => $userlite_poster,
|
||||
'tags' => \@taglist,
|
||||
'new_day' => 0,
|
||||
'end_day' => 0,
|
||||
'userpic' => $userpic,
|
||||
'permalink_url' => $permalink,
|
||||
});
|
||||
|
||||
return ($entry, $s2entry);
|
||||
}
|
||||
|
||||
1;
|
||||
441
livejournal/cgi-bin/LJ/S2/FriendsPage.pm
Executable file
441
livejournal/cgi-bin/LJ/S2/FriendsPage.pm
Executable file
@@ -0,0 +1,441 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
use strict;
|
||||
package LJ::S2;
|
||||
|
||||
sub FriendsPage
|
||||
{
|
||||
my ($u, $remote, $opts) = @_;
|
||||
|
||||
my $p = Page($u, $opts);
|
||||
$p->{'_type'} = "FriendsPage";
|
||||
$p->{'view'} = "friends";
|
||||
$p->{'entries'} = [];
|
||||
$p->{'friends'} = {};
|
||||
$p->{'friends_title'} = LJ::ehtml($u->{'friendspagetitle'});
|
||||
$p->{'filter_active'} = 0;
|
||||
$p->{'filter_name'} = "";
|
||||
|
||||
my $sth;
|
||||
my $user = $u->{'user'};
|
||||
|
||||
# see how often the remote user can reload this page.
|
||||
# "friendsviewupdate" time determines what granularity time
|
||||
# increments by for checking for new updates
|
||||
my $nowtime = time();
|
||||
|
||||
# update delay specified by "friendsviewupdate"
|
||||
my $newinterval = LJ::get_cap_min($remote, "friendsviewupdate") || 1;
|
||||
|
||||
# when are we going to say page was last modified? back up to the
|
||||
# most recent time in the past where $time % $interval == 0
|
||||
my $lastmod = $nowtime;
|
||||
$lastmod -= $lastmod % $newinterval;
|
||||
|
||||
# see if they have a previously cached copy of this page they
|
||||
# might be able to still use.
|
||||
if ($opts->{'header'}->{'If-Modified-Since'}) {
|
||||
my $theirtime = LJ::http_to_time($opts->{'header'}->{'If-Modified-Since'});
|
||||
|
||||
# send back a 304 Not Modified if they say they've reloaded this
|
||||
# document in the last $newinterval seconds:
|
||||
unless ($theirtime < $lastmod) {
|
||||
$opts->{'handler_return'} = 304;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
$opts->{'headers'}->{'Last-Modified'} = LJ::time_to_http($lastmod);
|
||||
|
||||
my $get = $opts->{'getargs'};
|
||||
|
||||
my $ret;
|
||||
|
||||
if ($get->{'mode'} eq "live") {
|
||||
$ret .= "<html><head><title>${user}'s friends: live!</title></head>\n";
|
||||
$ret .= "<frameset rows=\"100%,0%\" border=0>\n";
|
||||
$ret .= " <frame name=livetop src=\"friends?mode=framed\">\n";
|
||||
$ret .= " <frame name=livebottom src=\"friends?mode=livecond&lastitemid=0\">\n";
|
||||
$ret .= "</frameset></html>\n";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
if ($u->{'journaltype'} eq "R" && $u->{'renamedto'} ne "") {
|
||||
$opts->{'redir'} = LJ::journal_base($u->{'renamedto'}, $opts->{'vhost'}) . "/friends";
|
||||
return 1;
|
||||
}
|
||||
|
||||
LJ::load_user_props($remote, "opt_nctalklinks", "opt_stylemine", "opt_imagelinks", "opt_ljcut_disable_friends");
|
||||
|
||||
# load options for image links
|
||||
my ($maximgwidth, $maximgheight) = (undef, undef);
|
||||
($maximgwidth, $maximgheight) = ($1, $2)
|
||||
if ($remote && $remote->{'userid'} == $u->{'userid'} &&
|
||||
$remote->{'opt_imagelinks'} =~ m/^(\d+)\|(\d+)$/);
|
||||
|
||||
## never have spiders index friends pages (change too much, and some
|
||||
## people might not want to be indexed)
|
||||
$p->{'head_content'} .= LJ::robot_meta_tags();
|
||||
|
||||
my $itemshow = S2::get_property_value($opts->{'ctx'}, "page_friends_items")+0;
|
||||
if ($itemshow < 1) { $itemshow = 20; }
|
||||
elsif ($itemshow > 50) { $itemshow = 50; }
|
||||
|
||||
my $skip = $get->{'skip'}+0;
|
||||
my $maxskip = ($LJ::MAX_SCROLLBACK_FRIENDS || 1000) - $itemshow;
|
||||
if ($skip > $maxskip) { $skip = $maxskip; }
|
||||
if ($skip < 0) { $skip = 0; }
|
||||
my $itemload = $itemshow+$skip;
|
||||
|
||||
my $filter;
|
||||
my $group;
|
||||
my $common_filter = 1;
|
||||
|
||||
if (defined $get->{'filter'} && $remote && $remote->{'user'} eq $user) {
|
||||
$filter = $get->{'filter'};
|
||||
$common_filter = 0;
|
||||
$p->{'filter_active'} = 1;
|
||||
$p->{'filter_name'} = "";
|
||||
} else {
|
||||
if ($opts->{'pathextra'}) {
|
||||
$group = $opts->{'pathextra'};
|
||||
$group =~ s!^/!!;
|
||||
$group =~ s!/$!!;
|
||||
if ($group) { $group = LJ::durl($group); $common_filter = 0; }
|
||||
}
|
||||
if ($group) {
|
||||
$p->{'filter_active'} = 1;
|
||||
$p->{'filter_name'} = LJ::ehtml($group);
|
||||
}
|
||||
my $grp = LJ::get_friend_group($u, { 'name' => $group || "Default View" });
|
||||
my $bit = $grp->{'groupnum'};
|
||||
my $public = $grp->{'is_public'};
|
||||
if ($bit && ($public || ($remote && $remote->{'user'} eq $user))) {
|
||||
$filter = (1 << $bit);
|
||||
} elsif ($group) {
|
||||
$opts->{'badfriendgroup'} = 1;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
if ($opts->{'view'} eq "friendsfriends") {
|
||||
$p->{'friends_mode'} = "friendsfriends";
|
||||
}
|
||||
|
||||
if ($get->{'mode'} eq "livecond")
|
||||
{
|
||||
## load the itemids
|
||||
my @items = LJ::get_friend_items({
|
||||
'u' => $u,
|
||||
'userid' => $u->{'userid'},
|
||||
'remote' => $remote,
|
||||
'itemshow' => 1,
|
||||
'skip' => 0,
|
||||
'filter' => $filter,
|
||||
'common_filter' => $common_filter,
|
||||
});
|
||||
my $first = @items ? $items[0]->{'itemid'} : 0;
|
||||
|
||||
$ret .= "time = " . scalar(time()) . "<br />";
|
||||
$opts->{'headers'}->{'Refresh'} = "30;URL=$LJ::SITEROOT/users/$user/friends?mode=livecond&lastitemid=$first";
|
||||
if ($get->{'lastitemid'} == $first) {
|
||||
$ret .= "nothing new!";
|
||||
} else {
|
||||
if ($get->{'lastitemid'}) {
|
||||
$ret .= "<b>New stuff!</b>\n";
|
||||
$ret .= "<script language=\"JavaScript\">\n";
|
||||
$ret .= "window.parent.livetop.location.reload(true);\n";
|
||||
$ret .= "</script>\n";
|
||||
$opts->{'trusted_html'} = 1;
|
||||
} else {
|
||||
$ret .= "Friends Live! started.";
|
||||
}
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
## load the itemids
|
||||
my %friends;
|
||||
my %friends_row;
|
||||
my %idsbycluster;
|
||||
my @items = LJ::get_friend_items({
|
||||
'u' => $u,
|
||||
'userid' => $u->{'userid'},
|
||||
'remote' => $remote,
|
||||
'itemshow' => $itemshow,
|
||||
'skip' => $skip,
|
||||
'filter' => $filter,
|
||||
'common_filter' => $common_filter,
|
||||
'friends_u' => \%friends,
|
||||
'friends' => \%friends_row,
|
||||
'idsbycluster' => \%idsbycluster,
|
||||
'showtypes' => $get->{'show'},
|
||||
'friendsoffriends' => $opts->{'view'} eq "friendsfriends",
|
||||
'dateformat' => 'S2',
|
||||
});
|
||||
|
||||
while ($_ = each %friends) {
|
||||
# we expect fgcolor/bgcolor to be in here later
|
||||
$friends{$_}->{'fgcolor'} = $friends_row{$_}->{'fgcolor'} || '#ffffff';
|
||||
$friends{$_}->{'bgcolor'} = $friends_row{$_}->{'bgcolor'} || '#000000';
|
||||
}
|
||||
|
||||
return $p unless %friends;
|
||||
|
||||
### load the log properties
|
||||
my %logprops = (); # key is "$owneridOrZero $[j]itemid"
|
||||
LJ::load_log_props2multi(\%idsbycluster, \%logprops);
|
||||
|
||||
# load the text of the entries
|
||||
my $logtext = LJ::get_logtext2multi(\%idsbycluster);
|
||||
|
||||
# load tags on these entries
|
||||
my $logtags = LJ::Tags::get_logtagsmulti(\%idsbycluster);
|
||||
|
||||
my %posters;
|
||||
{
|
||||
my @posterids;
|
||||
foreach my $item (@items) {
|
||||
next if $friends{$item->{'posterid'}};
|
||||
push @posterids, $item->{'posterid'};
|
||||
}
|
||||
LJ::load_userids_multiple([ map { $_ => \$posters{$_} } @posterids ])
|
||||
if @posterids;
|
||||
}
|
||||
|
||||
my %objs_of_picid;
|
||||
my @userpic_load;
|
||||
|
||||
my %lite; # posterid -> s2_UserLite
|
||||
my $get_lite = sub {
|
||||
my $id = shift;
|
||||
return $lite{$id} if $lite{$id};
|
||||
return $lite{$id} = UserLite($posters{$id} || $friends{$id});
|
||||
};
|
||||
|
||||
my $eventnum = 0;
|
||||
my $hiddenentries = 0;
|
||||
ENTRY:
|
||||
foreach my $item (@items)
|
||||
{
|
||||
my ($friendid, $posterid, $itemid, $security, $alldatepart) =
|
||||
map { $item->{$_} } qw(ownerid posterid itemid security alldatepart);
|
||||
|
||||
my $fr = $friends{$friendid};
|
||||
$p->{'friends'}->{$fr->{'user'}} ||= Friend($fr);
|
||||
|
||||
my $clusterid = $item->{'clusterid'}+0;
|
||||
my $datakey = "$friendid $itemid";
|
||||
|
||||
my $replycount = $logprops{$datakey}->{'replycount'};
|
||||
my $subject = $logtext->{$datakey}->[0];
|
||||
my $text = $logtext->{$datakey}->[1];
|
||||
if ($get->{'nohtml'}) {
|
||||
# quote all non-LJ tags
|
||||
$subject =~ s{<(?!/?lj)(.*?)>} {<$1>}gi;
|
||||
$text =~ s{<(?!/?lj)(.*?)>} {<$1>}gi;
|
||||
}
|
||||
|
||||
if ($LJ::UNICODE && $logprops{$datakey}->{'unknown8bit'}) {
|
||||
LJ::item_toutf8($friends{$friendid}, \$subject, \$text, $logprops{$datakey});
|
||||
}
|
||||
|
||||
my ($friend, $poster);
|
||||
$friend = $poster = $friends{$friendid}->{'user'};
|
||||
|
||||
LJ::CleanHTML::clean_subject(\$subject) if $subject;
|
||||
|
||||
my $ditemid = $itemid * 256 + $item->{'anum'};
|
||||
|
||||
my $stylemine = "";
|
||||
$stylemine .= "style=mine" if $remote && $remote->{'opt_stylemine'} &&
|
||||
$remote->{'userid'} != $friendid;
|
||||
|
||||
LJ::CleanHTML::clean_event(\$text, { 'preformatted' => $logprops{$datakey}->{'opt_preformatted'},
|
||||
'cuturl' => LJ::item_link($friends{$friendid}, $itemid, $item->{'anum'}, $stylemine),
|
||||
'maximgwidth' => $maximgwidth,
|
||||
'maximgheight' => $maximgheight,
|
||||
'ljcut_disable' => $remote->{'opt_ljcut_disable_friends'}, });
|
||||
LJ::expand_embedded($friends{$friendid}, $ditemid, $remote, \$text);
|
||||
|
||||
my $userlite_poster = $get_lite->($posterid);
|
||||
my $userlite_journal = $get_lite->($friendid);
|
||||
|
||||
# get the poster user
|
||||
my $po = $posters{$posterid} || $friends{$posterid};
|
||||
|
||||
# don't allow posts from suspended users
|
||||
if ($po->{'statusvis'} eq 'S') {
|
||||
$hiddenentries++; # Remember how many we've skipped for later
|
||||
next ENTRY;
|
||||
}
|
||||
|
||||
# do the picture
|
||||
my $picid = 0;
|
||||
my $picu = undef;
|
||||
if ($friendid != $posterid && S2::get_property_value($opts->{ctx}, 'use_shared_pic')) {
|
||||
# using the community, the user wants to see shared pictures
|
||||
$picu = $friends{$friendid};
|
||||
|
||||
# use shared pic for community
|
||||
$picid = $friends{$friendid}->{defaultpicid};
|
||||
} else {
|
||||
# we're using the poster for this picture
|
||||
$picu = $po;
|
||||
|
||||
# check if they specified one
|
||||
$picid = LJ::get_picid_from_keyword($po, $logprops{$datakey}->{picture_keyword})
|
||||
if $logprops{$datakey}->{picture_keyword};
|
||||
|
||||
# fall back on the poster's default
|
||||
$picid ||= $po->{defaultpicid};
|
||||
}
|
||||
|
||||
my $nc = "";
|
||||
$nc .= "nc=$replycount" if $replycount && $remote && $remote->{'opt_nctalklinks'};
|
||||
|
||||
my $journalbase = LJ::journal_base($friends{$friendid});
|
||||
my $permalink = "$journalbase/$ditemid.html";
|
||||
my $readurl = LJ::Talk::talkargs($permalink, $nc, $stylemine);
|
||||
my $posturl = LJ::Talk::talkargs($permalink, "mode=reply", $stylemine);
|
||||
|
||||
my $comments = CommentInfo({
|
||||
'read_url' => $readurl,
|
||||
'post_url' => $posturl,
|
||||
'count' => $replycount,
|
||||
'maxcomments' => ($replycount >= LJ::get_cap($u, 'maxcomments')) ? 1 : 0,
|
||||
'enabled' => ($friends{$friendid}->{'opt_showtalklinks'} eq "Y" &&
|
||||
! $logprops{$datakey}->{'opt_nocomments'}) ? 1 : 0,
|
||||
'screened' => ($logprops{$datakey}->{'hasscreened'} && $remote &&
|
||||
($remote->{'user'} eq $fr->{'user'} || LJ::can_manage($remote, $fr))) ? 1 : 0,
|
||||
});
|
||||
|
||||
my $moodthemeid = $u->{'opt_forcemoodtheme'} eq 'Y' ?
|
||||
$u->{'moodthemeid'} : $friends{$friendid}->{'moodthemeid'};
|
||||
|
||||
my @taglist;
|
||||
while (my ($kwid, $kw) = each %{$logtags->{$datakey} || {}}) {
|
||||
push @taglist, Tag($friends{$friendid}, $kwid => $kw);
|
||||
}
|
||||
@taglist = sort { $a->{name} cmp $b->{name} } @taglist;
|
||||
|
||||
if ($opts->{enable_tags_compatibility} && @taglist) {
|
||||
$text .= LJ::S2::get_tags_text($opts->{ctx}, \@taglist);
|
||||
}
|
||||
|
||||
my $entry = Entry($u, {
|
||||
'subject' => $subject,
|
||||
'text' => $text,
|
||||
'dateparts' => $alldatepart,
|
||||
'security' => $security,
|
||||
'props' => $logprops{$datakey},
|
||||
'itemid' => $ditemid,
|
||||
'journal' => $userlite_journal,
|
||||
'poster' => $userlite_poster,
|
||||
'comments' => $comments,
|
||||
'new_day' => 0, # setup below
|
||||
'end_day' => 0, # setup below
|
||||
'userpic' => undef,
|
||||
'tags' => \@taglist,
|
||||
'permalink_url' => $permalink,
|
||||
'moodthemeid' => $moodthemeid,
|
||||
});
|
||||
$entry->{'_ymd'} = join('-', map { $entry->{'time'}->{$_} } qw(year month day));
|
||||
|
||||
if ($picid && $picu) {
|
||||
push @userpic_load, [ $picu, $picid ];
|
||||
push @{$objs_of_picid{$picid}}, \$entry->{'userpic'};
|
||||
}
|
||||
|
||||
push @{$p->{'entries'}}, $entry;
|
||||
$eventnum++;
|
||||
|
||||
} # end while
|
||||
|
||||
# set the new_day and end_day members.
|
||||
if ($eventnum) {
|
||||
for (my $i = 0; $i < $eventnum; $i++) {
|
||||
my $entry = $p->{'entries'}->[$i];
|
||||
$entry->{'new_day'} = 1;
|
||||
my $last = $i;
|
||||
for (my $j = $i+1; $j < $eventnum; $j++) {
|
||||
my $ej = $p->{'entries'}->[$j];
|
||||
if ($ej->{'_ymd'} eq $entry->{'_ymd'}) {
|
||||
$last = $j;
|
||||
}
|
||||
}
|
||||
$p->{'entries'}->[$last]->{'end_day'} = 1;
|
||||
$i = $last;
|
||||
}
|
||||
}
|
||||
|
||||
# load the pictures that were referenced, then retroactively populate
|
||||
# the userpic fields of the Entries above
|
||||
my %userpics;
|
||||
LJ::load_userpics(\%userpics, \@userpic_load);
|
||||
|
||||
foreach my $picid (keys %userpics) {
|
||||
my $up = Image("$LJ::USERPIC_ROOT/$picid/$userpics{$picid}->{'userid'}",
|
||||
$userpics{$picid}->{'width'},
|
||||
$userpics{$picid}->{'height'});
|
||||
foreach (@{$objs_of_picid{$picid}}) { $$_ = $up; }
|
||||
}
|
||||
|
||||
# make the skip links
|
||||
my $nav = {
|
||||
'_type' => 'RecentNav',
|
||||
'version' => 1,
|
||||
'skip' => $skip,
|
||||
'count' => $eventnum,
|
||||
};
|
||||
|
||||
my $base = "$u->{'_journalbase'}/$opts->{'view'}";
|
||||
if ($group) {
|
||||
$base .= "/" . LJ::eurl($group);
|
||||
}
|
||||
|
||||
# $linkfilter is distinct from $filter: if user has a default view,
|
||||
# $filter is now set according to it but we don't want it to show in the links.
|
||||
# $incfilter may be true even if $filter is 0: user may use filter=0 to turn
|
||||
# off the default group
|
||||
my $linkfilter = $get->{'filter'} + 0;
|
||||
my $incfilter = defined $get->{'filter'};
|
||||
|
||||
# if we've skipped down, then we can skip back up
|
||||
if ($skip) {
|
||||
my %linkvars;
|
||||
$linkvars{'filter'} = $linkfilter if $incfilter;
|
||||
$linkvars{'show'} = $get->{'show'} if $get->{'show'} =~ /^\w+$/;
|
||||
my $newskip = $skip - $itemshow;
|
||||
if ($newskip > 0) { $linkvars{'skip'} = $newskip; }
|
||||
else { $newskip = 0; }
|
||||
$nav->{'forward_url'} = LJ::make_link($base, \%linkvars);
|
||||
$nav->{'forward_skip'} = $newskip;
|
||||
$nav->{'forward_count'} = $itemshow;
|
||||
}
|
||||
|
||||
## unless we didn't even load as many as we were expecting on this
|
||||
## page, then there are more (unless there are exactly the number shown
|
||||
## on the page, but who cares about that)
|
||||
# Must remember to count $hiddenentries or we'll have no skiplinks when > 1
|
||||
unless (($eventnum + $hiddenentries) != $itemshow || $skip == $maxskip) {
|
||||
my %linkvars;
|
||||
$linkvars{'filter'} = $linkfilter if $incfilter;
|
||||
$linkvars{'show'} = $get->{'show'} if $get->{'show'} =~ /^\w+$/;
|
||||
my $newskip = $skip + $itemshow;
|
||||
$linkvars{'skip'} = $newskip;
|
||||
$nav->{'backward_url'} = LJ::make_link($base, \%linkvars);
|
||||
$nav->{'backward_skip'} = $newskip;
|
||||
$nav->{'backward_count'} = $itemshow;
|
||||
}
|
||||
|
||||
$p->{'nav'} = $nav;
|
||||
|
||||
if ($get->{'mode'} eq "framed") {
|
||||
$p->{'head_content'} .= "<base target='_top' />";
|
||||
}
|
||||
|
||||
return $p;
|
||||
}
|
||||
|
||||
1;
|
||||
232
livejournal/cgi-bin/LJ/S2/MonthPage.pm
Executable file
232
livejournal/cgi-bin/LJ/S2/MonthPage.pm
Executable file
@@ -0,0 +1,232 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
use strict;
|
||||
package LJ::S2;
|
||||
|
||||
sub MonthPage
|
||||
{
|
||||
my ($u, $remote, $opts) = @_;
|
||||
|
||||
my $get = $opts->{'getargs'};
|
||||
|
||||
my $p = Page($u, $opts);
|
||||
$p->{'_type'} = "MonthPage";
|
||||
$p->{'view'} = "month";
|
||||
$p->{'days'} = [];
|
||||
|
||||
my $ctx = $opts->{'ctx'};
|
||||
|
||||
my $dbcr = LJ::get_cluster_reader($u);
|
||||
|
||||
my $user = $u->{'user'};
|
||||
my $journalbase = LJ::journal_base($user, $opts->{'vhost'});
|
||||
|
||||
if ($u->{'journaltype'} eq "R" && $u->{'renamedto'} ne "") {
|
||||
$opts->{'redir'} = LJ::journal_base($u->{'renamedto'}, $opts->{'vhost'}) .
|
||||
"/" . $opts->{'pathextra'};
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ($u->{'opt_blockrobots'}) {
|
||||
$p->{'head_content'} .= LJ::robot_meta_tags();
|
||||
}
|
||||
|
||||
my ($year, $month);
|
||||
if ($opts->{'pathextra'} =~ m!^/(\d\d\d\d)/(\d\d)\b!) {
|
||||
($year, $month) = ($1, $2);
|
||||
}
|
||||
|
||||
$opts->{'errors'} = [];
|
||||
if ($month < 1 || $month > 12) { push @{$opts->{'errors'}}, "Invalid month: $month"; }
|
||||
if ($year < 1970 || $year > 2038) { push @{$opts->{'errors'}}, "Invalid year: $year"; }
|
||||
unless ($dbcr) { push @{$opts->{'errors'}}, "Database temporarily unavailable"; }
|
||||
return if @{$opts->{'errors'}};
|
||||
|
||||
$p->{'date'} = Date($year, $month, 0);
|
||||
|
||||
# load the log items
|
||||
my $dateformat = "%Y %m %d %H %i %s %w"; # yyyy mm dd hh mm ss day_of_week
|
||||
my $sth;
|
||||
|
||||
my $secwhere = "AND l.security='public'";
|
||||
my $viewall = 0;
|
||||
my $viewsome = 0;
|
||||
if ($remote) {
|
||||
|
||||
# do they have the viewall priv?
|
||||
if ($get->{'viewall'} && LJ::check_priv($remote, "canview")) {
|
||||
LJ::statushistory_add($u->{'userid'}, $remote->{'userid'},
|
||||
"viewall", "month: $user, statusvis: $u->{'statusvis'}");
|
||||
$viewall = LJ::check_priv($remote, 'canview', '*');
|
||||
$viewsome = $viewall || LJ::check_priv($remote, 'canview', 'suspended');
|
||||
}
|
||||
|
||||
if ($remote->{'userid'} == $u->{'userid'} || $viewall) {
|
||||
$secwhere = ""; # see everything
|
||||
} elsif ($remote->{'journaltype'} eq 'P') {
|
||||
my $gmask = LJ::get_groupmask($u, $remote);
|
||||
$secwhere = "AND (l.security='public' OR (l.security='usemask' AND l.allowmask & $gmask))"
|
||||
if $gmask;
|
||||
}
|
||||
}
|
||||
|
||||
$sth = $dbcr->prepare("SELECT l.jitemid, l.posterid, l.anum, l.day, ".
|
||||
" DATE_FORMAT(l.eventtime, '$dateformat') AS 'alldatepart', ".
|
||||
" l.replycount, l.security ".
|
||||
"FROM log2 l ".
|
||||
"WHERE l.journalid=? AND l.year=? AND l.month=? ".
|
||||
"$secwhere LIMIT 2000");
|
||||
$sth->execute($u->{userid}, $year, $month);
|
||||
|
||||
my @items;
|
||||
push @items, $_ while $_ = $sth->fetchrow_hashref;
|
||||
@items = sort { $a->{'alldatepart'} cmp $b->{'alldatepart'} } @items;
|
||||
|
||||
my @itemids = map { $_->{'jitemid'} } @items;
|
||||
|
||||
# load the log properties
|
||||
my %logprops = ();
|
||||
LJ::load_log_props2($u->{'userid'}, \@itemids, \%logprops);
|
||||
my $lt = LJ::get_logtext2($u, @itemids);
|
||||
|
||||
my (%pu, %pu_lite); # poster users; UserLite objects
|
||||
foreach (@items) {
|
||||
$pu{$_->{'posterid'}} = undef;
|
||||
}
|
||||
LJ::load_userids_multiple([map { $_, \$pu{$_} } keys %pu], [$u]);
|
||||
$pu_lite{$_} = UserLite($pu{$_}) foreach keys %pu;
|
||||
|
||||
my %day_entries; # <day> -> [ Entry+ ]
|
||||
|
||||
my $opt_text_subjects = S2::get_property_value($ctx, "page_month_textsubjects");
|
||||
my $userlite_journal = UserLite($u);
|
||||
|
||||
ENTRY:
|
||||
foreach my $item (@items)
|
||||
{
|
||||
my ($posterid, $itemid, $security, $alldatepart, $replycount, $anum) =
|
||||
map { $item->{$_} } qw(posterid jitemid security alldatepart replycount anum);
|
||||
my $subject = $lt->{$itemid}->[0];
|
||||
my $day = $item->{'day'};
|
||||
|
||||
# don't show posts from suspended users
|
||||
next unless $pu{$posterid};
|
||||
next ENTRY if $pu{$posterid}->{'statusvis'} eq 'S' && !$viewsome;
|
||||
|
||||
if ($LJ::UNICODE && $logprops{$itemid}->{'unknown8bit'}) {
|
||||
my $text;
|
||||
LJ::item_toutf8($u, \$subject, \$text, $logprops{$itemid});
|
||||
}
|
||||
|
||||
if ($opt_text_subjects) {
|
||||
LJ::CleanHTML::clean_subject_all(\$subject);
|
||||
} else {
|
||||
LJ::CleanHTML::clean_subject(\$subject);
|
||||
}
|
||||
|
||||
my $ditemid = $itemid*256 + $anum;
|
||||
my $nc = "";
|
||||
$nc .= "nc=$replycount" if $replycount && $remote && $remote->{'opt_nctalklinks'};
|
||||
my $permalink = "$journalbase/$ditemid.html";
|
||||
my $readurl = $permalink;
|
||||
$readurl .= "?$nc" if $nc;
|
||||
my $posturl = $permalink . "?mode=reply";
|
||||
|
||||
my $comments = CommentInfo({
|
||||
'read_url' => $readurl,
|
||||
'post_url' => $posturl,
|
||||
'count' => $replycount,
|
||||
'maxcomments' => ($replycount >= LJ::get_cap($u, 'maxcomments')) ? 1 : 0,
|
||||
'enabled' => ($u->{'opt_showtalklinks'} eq "Y" && ! $logprops{$itemid}->{'opt_nocomments'}) ? 1 : 0,
|
||||
'screened' => ($logprops{$itemid}->{'hasscreened'} && $remote &&
|
||||
($remote->{'user'} eq $u->{'user'} || LJ::can_manage($remote, $u))) ? 1 : 0,
|
||||
});
|
||||
|
||||
my $userlite_poster = $userlite_journal;
|
||||
my $userpic = $p->{'journal'}->{'default_pic'};
|
||||
if ($u->{'userid'} != $posterid) {
|
||||
$userlite_poster = $pu_lite{$posterid};
|
||||
$userpic = Image_userpic($pu{$posterid}, 0, $logprops{$itemid}->{'picture_keyword'});
|
||||
}
|
||||
|
||||
my $entry = Entry($u, {
|
||||
'subject' => $subject,
|
||||
'text' => "",
|
||||
'dateparts' => $alldatepart,
|
||||
'security' => $security,
|
||||
'props' => $logprops{$itemid},
|
||||
'itemid' => $ditemid,
|
||||
'journal' => $userlite_journal,
|
||||
'poster' => $userlite_poster,
|
||||
'comments' => $comments,
|
||||
'userpic' => $userpic,
|
||||
'permalink_url' => $permalink,
|
||||
});
|
||||
|
||||
push @{$day_entries{$day}}, $entry;
|
||||
}
|
||||
|
||||
my $days_month = LJ::days_in_month($month, $year);
|
||||
for my $day (1..$days_month) {
|
||||
my $entries = $day_entries{$day} || [];
|
||||
my $month_day = {
|
||||
'_type' => 'MonthDay',
|
||||
'date' => Date($year, $month, $day),
|
||||
'day' => $day,
|
||||
'has_entries' => scalar @$entries > 0,
|
||||
'num_entries' => scalar @$entries,
|
||||
'url' => $journalbase . sprintf("/%04d/%02d/%02d/", $year, $month, $day),
|
||||
'entries' => $entries,
|
||||
};
|
||||
push @{$p->{'days'}}, $month_day;
|
||||
}
|
||||
|
||||
# populate redirector
|
||||
my $vhost = $opts->{'vhost'};
|
||||
$vhost =~ s/:.*//;
|
||||
$p->{'redir'} = {
|
||||
'_type' => "Redirector",
|
||||
'user' => $u->{'user'},
|
||||
'vhost' => $vhost,
|
||||
'type' => 'monthview',
|
||||
'url' => "$LJ::SITEROOT/go.bml",
|
||||
};
|
||||
|
||||
# figure out what months have been posted into
|
||||
my $nowval = $year*12 + $month;
|
||||
|
||||
$p->{'months'} = [];
|
||||
|
||||
my $days = LJ::get_daycounts($u, $remote) || [];
|
||||
my $lastmo;
|
||||
foreach my $day (@$days) {
|
||||
my ($oy, $om) = ($day->[0], $day->[1]);
|
||||
my $mo = "$oy-$om";
|
||||
next if $mo eq $lastmo;
|
||||
$lastmo = $mo;
|
||||
|
||||
my $date = Date($oy, $om, 0);
|
||||
my $url = $journalbase . sprintf("/%04d/%02d/", $oy, $om);
|
||||
push @{$p->{'months'}}, {
|
||||
'_type' => "MonthEntryInfo",
|
||||
'date' => $date,
|
||||
'url' => $url,
|
||||
'redir_key' => sprintf("%04d%02d", $oy, $om),
|
||||
};
|
||||
|
||||
my $val = $oy*12+$om;
|
||||
if ($val < $nowval) {
|
||||
$p->{'prev_url'} = $url;
|
||||
$p->{'prev_date'} = $date;
|
||||
}
|
||||
if ($val > $nowval && ! $p->{'next_date'}) {
|
||||
$p->{'next_url'} = $url;
|
||||
$p->{'next_date'} = $date;
|
||||
}
|
||||
}
|
||||
|
||||
return $p;
|
||||
}
|
||||
|
||||
1;
|
||||
240
livejournal/cgi-bin/LJ/S2/RecentPage.pm
Executable file
240
livejournal/cgi-bin/LJ/S2/RecentPage.pm
Executable file
@@ -0,0 +1,240 @@
|
||||
use strict;
|
||||
package LJ::S2;
|
||||
|
||||
sub RecentPage
|
||||
{
|
||||
my ($u, $remote, $opts) = @_;
|
||||
|
||||
my $p = Page($u, $opts);
|
||||
$p->{'_type'} = "RecentPage";
|
||||
$p->{'view'} = "recent";
|
||||
$p->{'entries'} = [];
|
||||
|
||||
my $user = $u->{'user'};
|
||||
my $journalbase = LJ::journal_base($user, $opts->{'vhost'});
|
||||
|
||||
if ($u->{'journaltype'} eq "R" && $u->{'renamedto'} ne "") {
|
||||
$opts->{'redir'} = LJ::journal_base($u->{'renamedto'}, $opts->{'vhost'});
|
||||
return;
|
||||
}
|
||||
|
||||
LJ::load_user_props($remote, "opt_nctalklinks", "opt_ljcut_disable_lastn");
|
||||
|
||||
my $get = $opts->{'getargs'};
|
||||
|
||||
if ($opts->{'pathextra'}) {
|
||||
$opts->{'badargs'} = 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ($u->{'opt_blockrobots'} || $get->{'skip'}) {
|
||||
$p->{'head_content'} .= LJ::robot_meta_tags();
|
||||
}
|
||||
|
||||
$p->{'head_content'} .= qq{<link rel="openid.server" href="$LJ::OPENID_SERVER" />\n}
|
||||
if LJ::OpenID::server_enabled();
|
||||
|
||||
my $itemshow = S2::get_property_value($opts->{'ctx'}, "page_recent_items")+0;
|
||||
if ($itemshow < 1) { $itemshow = 20; }
|
||||
elsif ($itemshow > 50) { $itemshow = 50; }
|
||||
|
||||
my $skip = $get->{'skip'}+0;
|
||||
my $maxskip = $LJ::MAX_HINTS_LASTN-$itemshow;
|
||||
if ($skip < 0) { $skip = 0; }
|
||||
if ($skip > $maxskip) { $skip = $maxskip; }
|
||||
|
||||
# do they want to view all entries, regardless of security?
|
||||
my $viewall = 0;
|
||||
my $viewsome = 0;
|
||||
if ($get->{'viewall'} && LJ::check_priv($remote, "canview")) {
|
||||
LJ::statushistory_add($u->{'userid'}, $remote->{'userid'},
|
||||
"viewall", "lastn: $user, statusvis: $u->{'statusvis'}");
|
||||
$viewall = LJ::check_priv($remote, 'canview', '*');
|
||||
$viewsome = $viewall || LJ::check_priv($remote, 'canview', 'suspended');
|
||||
}
|
||||
|
||||
## load the itemids
|
||||
my @itemids;
|
||||
my $err;
|
||||
my @items = LJ::get_recent_items({
|
||||
'clusterid' => $u->{'clusterid'},
|
||||
'clustersource' => 'slave',
|
||||
'viewall' => $viewall,
|
||||
'userid' => $u->{'userid'},
|
||||
'remote' => $remote,
|
||||
'itemshow' => $itemshow,
|
||||
'skip' => $skip,
|
||||
'tagids' => $opts->{tagids},
|
||||
'itemids' => \@itemids,
|
||||
'dateformat' => 'S2',
|
||||
'order' => ($u->{'journaltype'} eq "C" || $u->{'journaltype'} eq "Y") # community or syndicated
|
||||
? "logtime" : "",
|
||||
'err' => \$err,
|
||||
});
|
||||
|
||||
die $err if $err;
|
||||
|
||||
### load the log properties
|
||||
my %logprops = ();
|
||||
my $logtext;
|
||||
LJ::load_log_props2($u->{'userid'}, \@itemids, \%logprops);
|
||||
$logtext = LJ::get_logtext2($u, @itemids);
|
||||
|
||||
my $lastdate = "";
|
||||
my $itemnum = 0;
|
||||
my $lastentry = undef;
|
||||
|
||||
my (%apu, %apu_lite); # alt poster users; UserLite objects
|
||||
foreach (@items) {
|
||||
next unless $_->{'posterid'} != $u->{'userid'};
|
||||
$apu{$_->{'posterid'}} = undef;
|
||||
}
|
||||
if (%apu) {
|
||||
LJ::load_userids_multiple([map { $_, \$apu{$_} } keys %apu], [$u]);
|
||||
$apu_lite{$_} = UserLite($apu{$_}) foreach keys %apu;
|
||||
}
|
||||
|
||||
# load tags
|
||||
my $idsbyc = { $u->{clusterid} => [ ] };
|
||||
push @{$idsbyc->{$u->{clusterid}}}, [ $u->{userid}, $_->{itemid} ]
|
||||
foreach @items;
|
||||
my $tags = LJ::Tags::get_logtagsmulti($idsbyc);
|
||||
|
||||
my $userlite_journal = UserLite($u);
|
||||
|
||||
ENTRY:
|
||||
foreach my $item (@items)
|
||||
{
|
||||
my ($posterid, $itemid, $security, $alldatepart) =
|
||||
map { $item->{$_} } qw(posterid itemid security alldatepart);
|
||||
|
||||
my $replycount = $logprops{$itemid}->{'replycount'};
|
||||
my $subject = $logtext->{$itemid}->[0];
|
||||
my $text = $logtext->{$itemid}->[1];
|
||||
if ($get->{'nohtml'}) {
|
||||
# quote all non-LJ tags
|
||||
$subject =~ s{<(?!/?lj)(.*?)>} {<$1>}gi;
|
||||
$text =~ s{<(?!/?lj)(.*?)>} {<$1>}gi;
|
||||
}
|
||||
|
||||
# don't show posts from suspended users unless the user doing the viewing says to (and is allowed)
|
||||
next ENTRY if $apu{$posterid} && $apu{$posterid}->{'statusvis'} eq 'S' && !$viewsome;
|
||||
|
||||
if ($LJ::UNICODE && $logprops{$itemid}->{'unknown8bit'}) {
|
||||
LJ::item_toutf8($u, \$subject, \$text, $logprops{$itemid});
|
||||
}
|
||||
|
||||
my $date = substr($alldatepart, 0, 10);
|
||||
my $new_day = 0;
|
||||
if ($date ne $lastdate) {
|
||||
$new_day = 1;
|
||||
$lastdate = $date;
|
||||
$lastentry->{'end_day'} = 1 if $lastentry;
|
||||
}
|
||||
|
||||
$itemnum++;
|
||||
LJ::CleanHTML::clean_subject(\$subject) if $subject;
|
||||
|
||||
my $ditemid = $itemid * 256 + $item->{'anum'};
|
||||
LJ::CleanHTML::clean_event(\$text, { 'preformatted' => $logprops{$itemid}->{'opt_preformatted'},
|
||||
'cuturl' => LJ::item_link($u, $itemid, $item->{'anum'}),
|
||||
'ljcut_disable' => $remote->{"opt_ljcut_disable_lastn"}, });
|
||||
LJ::expand_embedded($u, $ditemid, $remote, \$text);
|
||||
|
||||
my @taglist;
|
||||
while (my ($kwid, $kw) = each %{$tags->{"$u->{userid} $itemid"} || {}}) {
|
||||
push @taglist, Tag($u, $kwid => $kw);
|
||||
}
|
||||
@taglist = sort { $a->{name} cmp $b->{name} } @taglist;
|
||||
|
||||
if ($opts->{enable_tags_compatibility} && @taglist) {
|
||||
$text .= LJ::S2::get_tags_text($opts->{ctx}, \@taglist);
|
||||
}
|
||||
|
||||
my $nc = "";
|
||||
$nc .= "nc=$replycount" if $replycount && $remote && $remote->{'opt_nctalklinks'};
|
||||
|
||||
my $permalink = "$journalbase/$ditemid.html";
|
||||
my $readurl = $permalink;
|
||||
$readurl .= "?$nc" if $nc;
|
||||
my $posturl = $permalink . "?mode=reply";
|
||||
|
||||
my $comments = CommentInfo({
|
||||
'read_url' => $readurl,
|
||||
'post_url' => $posturl,
|
||||
'count' => $replycount,
|
||||
'maxcomments' => ($replycount >= LJ::get_cap($u, 'maxcomments')) ? 1 : 0,
|
||||
'enabled' => ($u->{'opt_showtalklinks'} eq "Y" && ! $logprops{$itemid}->{'opt_nocomments'}) ? 1 : 0,
|
||||
'screened' => ($logprops{$itemid}->{'hasscreened'} && ($remote->{'user'} eq $u->{'user'}|| LJ::can_manage($remote, $u))) ? 1 : 0,
|
||||
});
|
||||
|
||||
my $userlite_poster = $userlite_journal;
|
||||
my $pu = $u;
|
||||
if ($u->{'userid'} != $posterid) {
|
||||
$userlite_poster = $apu_lite{$posterid} or die "No apu_lite for posterid=$posterid";
|
||||
$pu = $apu{$posterid};
|
||||
}
|
||||
my $userpic = Image_userpic($pu, 0, $logprops{$itemid}->{'picture_keyword'});
|
||||
|
||||
my $entry = $lastentry = Entry($u, {
|
||||
'subject' => $subject,
|
||||
'text' => $text,
|
||||
'dateparts' => $alldatepart,
|
||||
'security' => $security,
|
||||
'props' => $logprops{$itemid},
|
||||
'itemid' => $ditemid,
|
||||
'journal' => $userlite_journal,
|
||||
'poster' => $userlite_poster,
|
||||
'comments' => $comments,
|
||||
'new_day' => $new_day,
|
||||
'end_day' => 0, # if true, set later
|
||||
'tags' => \@taglist,
|
||||
'userpic' => $userpic,
|
||||
'permalink_url' => $permalink,
|
||||
});
|
||||
|
||||
push @{$p->{'entries'}}, $entry;
|
||||
|
||||
} # end huge while loop
|
||||
|
||||
# mark last entry as closing.
|
||||
$p->{'entries'}->[-1]->{'end_day'} = 1 if $itemnum;
|
||||
|
||||
#### make the skip links
|
||||
my $nav = {
|
||||
'_type' => 'RecentNav',
|
||||
'version' => 1,
|
||||
'skip' => $skip,
|
||||
'count' => $itemnum,
|
||||
};
|
||||
|
||||
# if we've skipped down, then we can skip back up
|
||||
if ($skip) {
|
||||
my $newskip = $skip - $itemshow;
|
||||
$newskip = 0 if $newskip <= 0;
|
||||
$nav->{'forward_skip'} = $newskip;
|
||||
$nav->{'forward_url'} = LJ::make_link("$p->{base_url}/", { skip => ($newskip || ""), tag => (LJ::eurl($get->{tag}) || "") });
|
||||
$nav->{'forward_count'} = $itemshow;
|
||||
}
|
||||
|
||||
# unless we didn't even load as many as we were expecting on this
|
||||
# page, then there are more (unless there are exactly the number shown
|
||||
# on the page, but who cares about that)
|
||||
unless ($itemnum != $itemshow) {
|
||||
$nav->{'backward_count'} = $itemshow;
|
||||
if ($skip == $maxskip) {
|
||||
my $date_slashes = $lastdate; # "yyyy mm dd";
|
||||
$date_slashes =~ s! !/!g;
|
||||
$nav->{'backward_url'} = "$p->{'base_url'}/day/$date_slashes";
|
||||
} else {
|
||||
my $newskip = $skip + $itemshow;
|
||||
$nav->{'backward_url'} = LJ::make_link("$p->{'base_url'}/", { skip => ($newskip || ""), tag => (LJ::eurl($get->{tag}) || "") });
|
||||
$nav->{'backward_skip'} = $newskip;
|
||||
}
|
||||
}
|
||||
|
||||
$p->{'nav'} = $nav;
|
||||
return $p;
|
||||
}
|
||||
|
||||
1;
|
||||
139
livejournal/cgi-bin/LJ/S2/ReplyPage.pm
Executable file
139
livejournal/cgi-bin/LJ/S2/ReplyPage.pm
Executable file
@@ -0,0 +1,139 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
use strict;
|
||||
package LJ::S2;
|
||||
|
||||
sub ReplyPage
|
||||
{
|
||||
my ($u, $remote, $opts) = @_;
|
||||
|
||||
my $p = Page($u, $opts);
|
||||
$p->{'_type'} = "ReplyPage";
|
||||
$p->{'view'} = "reply";
|
||||
|
||||
my $get = $opts->{'getargs'};
|
||||
|
||||
my ($entry, $s2entry) = EntryPage_entry($u, $remote, $opts);
|
||||
return if $opts->{'suspendeduser'};
|
||||
return if $opts->{'handler_return'};
|
||||
my $ditemid = $entry->{'itemid'}*256 + $entry->{'anum'};
|
||||
$p->{'head_content'} .= $LJ::COMMON_CODE{'chalresp_js'};
|
||||
|
||||
if ($u->{'opt_blockrobots'}) {
|
||||
$p->{'head_content'} .= LJ::robot_meta_tags();
|
||||
}
|
||||
|
||||
$p->{'entry'} = $s2entry;
|
||||
|
||||
# setup the replying item
|
||||
my $replyto = $s2entry;
|
||||
my $parpost;
|
||||
if ($get->{'replyto'}) {
|
||||
my $re_talkid = int($get->{'replyto'} >> 8);
|
||||
my $re_anum = $get->{'replyto'} % 256;
|
||||
unless ($re_anum == $entry->{'anum'}) {
|
||||
$opts->{'handler_return'} = 404;
|
||||
return;
|
||||
}
|
||||
|
||||
my $sql = "SELECT jtalkid, posterid, state, datepost FROM talk2 ".
|
||||
"WHERE journalid=$u->{'userid'} AND jtalkid=$re_talkid ".
|
||||
"AND nodetype='L' AND nodeid=$entry->{'jitemid'}";
|
||||
foreach my $pass (1, 2) {
|
||||
my $db = $pass == 1 ? LJ::get_cluster_reader($u) : LJ::get_cluster_def_reader($u);
|
||||
$parpost = $db->selectrow_hashref($sql);
|
||||
last if $parpost;
|
||||
}
|
||||
unless ($parpost and $parpost->{'state'} ne 'D') {
|
||||
$opts->{'handler_return'} = 404;
|
||||
return;
|
||||
}
|
||||
if ($parpost->{'state'} eq 'S' && !LJ::Talk::can_unscreen($remote, $u, $s2entry->{'poster'}->{'username'}, undef)) {
|
||||
$opts->{'handler_return'} = 403;
|
||||
return;
|
||||
}
|
||||
if ($parpost->{'state'} eq 'F') {
|
||||
# frozen comment, no replies allowed
|
||||
|
||||
# FIXME: eventually have S2 ErrorPage to handle this and similar
|
||||
# For now, this hack will work; this error is pretty uncommon anyway.
|
||||
$opts->{status} = "403 Forbidden";
|
||||
return "<p>This thread has been frozen; no more replies are allowed.</p>";
|
||||
}
|
||||
|
||||
my $tt = LJ::get_talktext2($u, $re_talkid);
|
||||
$parpost->{'subject'} = $tt->{$re_talkid}->[0];
|
||||
$parpost->{'body'} = $tt->{$re_talkid}->[1];
|
||||
$parpost->{'props'} =
|
||||
LJ::load_talk_props2($u, [ $re_talkid ])->{$re_talkid} || {};
|
||||
|
||||
if($LJ::UNICODE && $parpost->{'props'}->{'unknown8bit'}) {
|
||||
LJ::item_toutf8($u, \$parpost->{'subject'}, \$parpost->{'body'}, {});
|
||||
}
|
||||
|
||||
LJ::CleanHTML::clean_comment(\$parpost->{'body'},
|
||||
{ 'preformatted' => $parpost->{'props'}->{'opt_preformatted'},
|
||||
'anon_comment' => !$parpost->{posterid} });
|
||||
|
||||
my $datetime = DateTime_unix(LJ::mysqldate_to_time($parpost->{'datepost'}));
|
||||
|
||||
my ($s2poster, $pu);
|
||||
my $comment_userpic;
|
||||
if ($parpost->{'posterid'}) {
|
||||
$pu = LJ::load_userid($parpost->{'posterid'});
|
||||
return $opts->{handler_return} = 403 if $pu->{statusvis} eq 'S'; # do not show comments by suspended users
|
||||
$s2poster = UserLite($pu);
|
||||
|
||||
# FIXME: this is a little heavy:
|
||||
$comment_userpic = Image_userpic($pu, 0, $parpost->{'props'}->{'picture_keyword'});
|
||||
}
|
||||
|
||||
my $dtalkid = $re_talkid * 256 + $entry->{'anum'};
|
||||
$replyto = {
|
||||
'_type' => 'EntryLite',
|
||||
'subject' => LJ::ehtml($parpost->{'subject'}),
|
||||
'text' => $parpost->{'body'},
|
||||
'userpic' => $comment_userpic,
|
||||
'poster' => $s2poster,
|
||||
'journal' => $s2entry->{'journal'},
|
||||
'metadata' => {},
|
||||
'permalink_url' => $u->{'_journalbase'} . "/$ditemid.html?view=$dtalkid#t$dtalkid",
|
||||
'depth' => 1,
|
||||
'time' => $datetime,
|
||||
};
|
||||
}
|
||||
|
||||
$p->{'replyto'} = $replyto;
|
||||
|
||||
$p->{'form'} = {
|
||||
'_type' => "ReplyForm",
|
||||
'_remote' => $remote,
|
||||
'_u' => $u,
|
||||
'_ditemid' => $ditemid,
|
||||
'_parpost' => $parpost,
|
||||
};
|
||||
|
||||
return $p;
|
||||
}
|
||||
|
||||
package S2::Builtin::LJ;
|
||||
|
||||
sub ReplyForm__print
|
||||
{
|
||||
my ($ctx, $form) = @_;
|
||||
my $remote = $form->{'_remote'};
|
||||
my $u = $form->{'_u'};
|
||||
my $parpost = $form->{'_parpost'};
|
||||
my $parent = $parpost ? $parpost->{'jtalkid'} : 0;
|
||||
|
||||
$S2::pout->(LJ::Talk::talkform({ 'remote' => $remote,
|
||||
'journalu' => $u,
|
||||
'parpost' => $parpost,
|
||||
'replyto' => $parent,
|
||||
'ditemid' => $form->{'_ditemid'},
|
||||
'form' => $form }));
|
||||
|
||||
}
|
||||
|
||||
1;
|
||||
181
livejournal/cgi-bin/LJ/S2/YearPage.pm
Executable file
181
livejournal/cgi-bin/LJ/S2/YearPage.pm
Executable file
@@ -0,0 +1,181 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
use strict;
|
||||
package LJ::S2;
|
||||
|
||||
sub YearPage
|
||||
{
|
||||
my ($u, $remote, $opts) = @_;
|
||||
|
||||
my $p = Page($u, $opts);
|
||||
$p->{'_type'} = "YearPage";
|
||||
$p->{'view'} = "archive";
|
||||
|
||||
my $user = $u->{'user'};
|
||||
|
||||
if ($u->{'journaltype'} eq "R" && $u->{'renamedto'} ne "") {
|
||||
$opts->{'redir'} = LJ::journal_base($u->{'renamedto'}, $opts->{'vhost'}) .
|
||||
"/calendar" . $opts->{'pathextra'};
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ($u->{'opt_blockrobots'}) {
|
||||
$p->{'head_content'} .= LJ::robot_meta_tags();
|
||||
}
|
||||
if ($LJ::UNICODE) {
|
||||
$p->{'head_content'} .= '<meta http-equiv="Content-Type" content="text/html; charset='.$opts->{'saycharset'}."\" />\n";
|
||||
}
|
||||
|
||||
my $get = $opts->{'getargs'};
|
||||
|
||||
my $count = LJ::S2::get_journal_day_counts($p);
|
||||
my @years = sort { $a <=> $b } keys %$count;
|
||||
my $maxyear = @years ? $years[-1] : undef;
|
||||
my $year = $get->{'year'}; # old form was /users/<user>/calendar?year=1999
|
||||
|
||||
# but the new form is purtier: */calendar/2001
|
||||
if (! $year && $opts->{'pathextra'} =~ m!^/(\d\d\d\d)/?\b!) {
|
||||
$year = $1;
|
||||
}
|
||||
|
||||
# else... default to the year they last posted.
|
||||
$year ||= $maxyear;
|
||||
|
||||
$p->{'year'} = $year;
|
||||
$p->{'years'} = [];
|
||||
foreach (@years) {
|
||||
push @{$p->{'years'}}, YearYear($_, "$p->{'base_url'}/$_/", $_ == $p->{'year'});
|
||||
}
|
||||
|
||||
$p->{'months'} = [];
|
||||
|
||||
for my $month (1..12) {
|
||||
push @{$p->{'months'}}, YearMonth($p, {
|
||||
'month' => $month,
|
||||
'year' => $year,
|
||||
});
|
||||
}
|
||||
|
||||
return $p;
|
||||
}
|
||||
|
||||
sub YearMonth {
|
||||
my ($p, $calmon) = @_;
|
||||
|
||||
my ($month, $year) = ($calmon->{'month'}, $calmon->{'year'});
|
||||
$calmon->{'_type'} = 'YearMonth';
|
||||
$calmon->{'weeks'} = [];
|
||||
$calmon->{'url'} = sprintf("$p->{'_u'}->{'_journalbase'}/$year/%02d/", $month);
|
||||
|
||||
my $count = LJ::S2::get_journal_day_counts($p);
|
||||
my $has_entries = $count->{$year} && $count->{$year}->{$month} ? 1 : 0;
|
||||
$calmon->{'has_entries'} = $has_entries;
|
||||
|
||||
my $start_monday = 0; # FIXME: check some property to see if weeks start on monday
|
||||
my $week = undef;
|
||||
|
||||
my $flush_week = sub {
|
||||
my $end_month = shift;
|
||||
return unless $week;
|
||||
push @{$calmon->{'weeks'}}, $week;
|
||||
if ($end_month) {
|
||||
$week->{'post_empty'} =
|
||||
7 - $week->{'pre_empty'} - @{$week->{'days'}};
|
||||
}
|
||||
$week = undef;
|
||||
};
|
||||
|
||||
my $push_day = sub {
|
||||
my $d = shift;
|
||||
unless ($week) {
|
||||
my $leading = $d->{'date'}->{'_dayofweek'}-1;
|
||||
if ($start_monday) {
|
||||
$leading = 6 if --$leading < 0;
|
||||
}
|
||||
$week = {
|
||||
'_type' => 'YearWeek',
|
||||
'days' => [],
|
||||
'pre_empty' => $leading,
|
||||
'post_empty' => 0,
|
||||
};
|
||||
}
|
||||
push @{$week->{'days'}}, $d;
|
||||
if ($week->{'pre_empty'} + @{$week->{'days'}} == 7) {
|
||||
$flush_week->();
|
||||
my $size = scalar @{$calmon->{'weeks'}};
|
||||
}
|
||||
};
|
||||
|
||||
my $day_of_week = LJ::day_of_week($year, $month, 1);
|
||||
|
||||
my $daysinmonth = LJ::days_in_month($month, $year);
|
||||
|
||||
for my $day (1..$daysinmonth) {
|
||||
# so we don't auto-vivify years/months
|
||||
my $daycount = $has_entries ? $count->{$year}->{$month}->{$day} : 0;
|
||||
my $d = YearDay($p->{'_u'}, $year, $month, $day,
|
||||
$daycount, $day_of_week+1);
|
||||
$push_day->($d);
|
||||
$day_of_week = ($day_of_week + 1) % 7;
|
||||
}
|
||||
$flush_week->(1); # end of month flag
|
||||
|
||||
my $nowval = $year * 12 + $month;
|
||||
|
||||
# determine the most recent month with posts that is older than
|
||||
# the current time $month/$year. gives calendars the ability to
|
||||
# provide smart next/previous links.
|
||||
my $maxbefore;
|
||||
while (my ($iy, $h) = each %$count) {
|
||||
next if $iy > $year;
|
||||
while (my $im = each %$h) {
|
||||
next if $im >= $month;
|
||||
my $val = $iy * 12 + $im;
|
||||
if ($val < $nowval && $val > $maxbefore) {
|
||||
$maxbefore = $val;
|
||||
$calmon->{'prev_url'} = $p->{'_u'}->{'_journalbase'} . sprintf("/%04d/%02d/", $iy, $im);
|
||||
$calmon->{'prev_date'} = Date($iy, $im, 0);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# same, except inverse: next month after current time with posts
|
||||
my $minafter;
|
||||
while (my ($iy, $h) = each %$count) {
|
||||
next if $iy < $year;
|
||||
while (my $im = each %$h) {
|
||||
next if $im <= $month;
|
||||
my $val = $iy * 12 + $im;
|
||||
if ($val > $nowval && (!$minafter || $val < $minafter)) {
|
||||
$minafter = $val;
|
||||
$calmon->{'next_url'} = $p->{'_u'}->{'_journalbase'} . sprintf("/%04d/%02d/", $iy, $im);
|
||||
$calmon->{'next_date'} = Date($iy, $im, 0);
|
||||
}
|
||||
}
|
||||
}
|
||||
return $calmon;
|
||||
}
|
||||
|
||||
sub YearYear {
|
||||
my ($year, $url, $displayed) = @_;
|
||||
return { '_type' => "YearYear",
|
||||
'year' => $year, 'url' => $url, 'displayed' => $displayed };
|
||||
}
|
||||
|
||||
sub YearDay {
|
||||
my ($u, $year, $month, $day, $count, $dow) = @_;
|
||||
my $d = {
|
||||
'_type' => 'YearDay',
|
||||
'day' => $day,
|
||||
'date' => Date($year, $month, $day, $dow),
|
||||
'num_entries' => $count
|
||||
};
|
||||
if ($count) {
|
||||
$d->{'url'} = sprintf("$u->{'_journalbase'}/$year/%02d/%02d/",
|
||||
$month, $day);
|
||||
}
|
||||
return $d;
|
||||
}
|
||||
|
||||
1;
|
||||
207
livejournal/cgi-bin/LJ/SixDegrees.pm
Executable file
207
livejournal/cgi-bin/LJ/SixDegrees.pm
Executable file
@@ -0,0 +1,207 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
use strict;
|
||||
use lib "$ENV{'LJHOME'}/cgi-bin";
|
||||
require 'ljlib.pl';
|
||||
|
||||
package LJ::SixDegrees;
|
||||
|
||||
sub find_path
|
||||
{
|
||||
my ($fu, $tu, $timeout) = @_;
|
||||
return () unless $fu && $tu;
|
||||
return () unless $fu->{journaltype} eq "P" && $tu->{journaltype} eq "P";
|
||||
|
||||
$LJ::SixDegrees::MEMC_EXPIRE ||= 86400;
|
||||
|
||||
my $cache = {}; # keys for links in/out -> listrefs, userids -> $u's, "notes" -> why pass/fail
|
||||
$cache->{$fu->{userid}} = $fu;
|
||||
$cache->{$tu->{userid}} = $tu;
|
||||
|
||||
my $memkey = [ $fu->{'userid'}, "6dpath:$fu->{userid}:$tu->{userid}" ];
|
||||
my $exp = 3600;
|
||||
my $path = LJ::MemCache::get($memkey);
|
||||
unless ($path) {
|
||||
$path = _find_path_helper($fu, $tu, $timeout, $cache);
|
||||
LJ::MemCache::set($memkey, $path, $exp) if $path;
|
||||
}
|
||||
|
||||
return () unless $path;
|
||||
return map { $cache->{$_} || LJ::load_userid($_) } @$path;
|
||||
}
|
||||
|
||||
# returns arrayref of userids in path on success (even if empty), or undef on timeout
|
||||
sub _find_path_helper
|
||||
{
|
||||
my ($fu, $tu, $timeout, $cache) = @_;
|
||||
|
||||
my $time_start = time();
|
||||
|
||||
# user is themselves (one element in path)
|
||||
return [$fu->{userid}] if $fu->{'userid'} == $tu->{'userid'};
|
||||
|
||||
# from user befriends to user (two elements in path
|
||||
my $fu_friends = links_out($fu, $cache);
|
||||
if (intersect($fu_friends, [ $tu->{'userid'} ])) {
|
||||
$cache->{'note'} = "2 way path";
|
||||
return [$fu->{userid}, $tu->{userid}];
|
||||
}
|
||||
|
||||
# try to find a three-way path (fu has a friend who lists tu as a friend)
|
||||
my $tu_friendofs = links_in($tu, $cache);
|
||||
if (my $via = intersect($fu_friends, $tu_friendofs)) {
|
||||
$cache->{'note'} = "3 way path";
|
||||
return [$fu->{userid}, $via, $tu->{userid}];
|
||||
}
|
||||
|
||||
# try to find four-way path by expanding fu's friends' friends,
|
||||
# one at a time, looking for intersections. along the way,
|
||||
# keep track of all friendsfriends, then we can walk along
|
||||
# tu's friendofs-friendofs looking for intersections there later
|
||||
# if necessary.
|
||||
my %friendsfriends = (); # uid -> 1
|
||||
my %friends = (); # uid -> 1
|
||||
my $tried = 0;
|
||||
foreach my $fid (@$fu_friends) {
|
||||
$friends{$fid} = 1;
|
||||
next if ++$tried > 100;
|
||||
if (time() > $time_start + $timeout) {
|
||||
$cache->{'note'} = "timeout";
|
||||
return undef;
|
||||
}
|
||||
|
||||
# a group of one friend's ($fid's) friends
|
||||
my $ffset = links_out($fid, $cache);
|
||||
|
||||
# see if $fid's friends intersect $tu's friendofs
|
||||
if (intersect($ffset, [ $tu->{userid} ])) {
|
||||
$cache->{'note'} = "returning via fid's friends to tu";
|
||||
return [$fu->{userid}, $fid, $tu->{userid}];
|
||||
}
|
||||
|
||||
# see if $fid's friends intersect $tu's friendofs
|
||||
if (my $via = intersect($ffset, $tu_friendofs)) {
|
||||
$cache->{'note'} = "returning via fid's friends to tu's friendofs";
|
||||
return [$fu->{userid}, $fid, $via, $tu->{userid}];
|
||||
}
|
||||
|
||||
# otherwise, track who's a friends-of-friend, and the friend we're on
|
||||
# so we don't try doing the same search later
|
||||
foreach (@$ffset) {
|
||||
$friendsfriends{$_} ||= $fid;
|
||||
}
|
||||
}
|
||||
|
||||
# try to find a path by looking at tu's friendof-friendofs
|
||||
$tried = 0;
|
||||
foreach my $foid (@$tu_friendofs) {
|
||||
last if ++$tried > 100;
|
||||
if (time() > $time_start + $timeout) {
|
||||
$cache->{'note'} = "timeout";
|
||||
return undef;
|
||||
}
|
||||
|
||||
if (my $fid = $friendsfriends{$foid}) {
|
||||
$cache->{'note'} = "returning via friend-of-friend is friend of target";
|
||||
return [$fu->{userid}, $fid, $foid, $tu->{userid}];
|
||||
}
|
||||
|
||||
my $foset = links_in($foid, $cache);
|
||||
|
||||
# see if we can go from $tu to $foid's friends. (now, this shouldn't normally
|
||||
# happen, but we limit the links_in/out to 1000, so there's a possibility
|
||||
# we stopped during the friend-of-friend search above)
|
||||
if (intersect([ $fu->{userid} ], $foset)) {
|
||||
$cache->{'note'} = "returning via friend-of-friend but discovered backwards";
|
||||
return [$fu->{userid}, $foid, $tu->{userid}];
|
||||
}
|
||||
|
||||
# otherwise, see if any of this group of friendof-friendofs are a friend-friend
|
||||
foreach my $uid (@$foset) {
|
||||
if (my $fid = $friends{$uid}) {
|
||||
$cache->{'note'} = "returning via friend intersection with friendof-friendof";
|
||||
return [$fu->{userid}, $fid, $foid, $tu->{userid}];
|
||||
}
|
||||
if (my $fid = $friendsfriends{$uid}) {
|
||||
$cache->{'note'} = "returning via friend-of-friend intersection with friendof-friendof";
|
||||
return [$fu->{userid}, $fid, $uid, $foid, $tu->{userid}];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return []; # no path, but not a timeout (as opposed to undef above)
|
||||
}
|
||||
|
||||
sub intersect
|
||||
{
|
||||
my ($list_a, $list_b) = @_;
|
||||
return 0 unless ref $list_a && ref $list_b;
|
||||
my %temp;
|
||||
$temp{$_} = 1 foreach @$list_a;
|
||||
foreach (@$list_b) {
|
||||
return $_ if $temp{$_};
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub link_fetch
|
||||
{
|
||||
my ($uid, $key, $sql, $cache) = @_;
|
||||
|
||||
# first try from the pre-load/already-done per-process cache
|
||||
return $cache->{$key} if defined $cache->{$key};
|
||||
|
||||
# then try memcache
|
||||
my $memkey = [$uid, $key];
|
||||
my $listref = LJ::MemCache::get($memkey);
|
||||
if (ref $listref eq "ARRAY") {
|
||||
$cache->{$key} = $listref;
|
||||
return $listref;
|
||||
}
|
||||
|
||||
# finally fall back to the database.
|
||||
my $dbr = LJ::get_db_reader();
|
||||
$listref = $dbr->selectcol_arrayref($sql, undef, $uid) || [];
|
||||
|
||||
# get the $u's for everybody (bleh, since we need to know if they're a community
|
||||
# or not)
|
||||
my @need_load; # userids necessary to load
|
||||
foreach my $uid (@$listref) {
|
||||
push @need_load, $uid unless $cache->{$uid};
|
||||
}
|
||||
if (@need_load) {
|
||||
LJ::load_userids_multiple([ map { $_, \$cache->{$_} } @need_load ]);
|
||||
}
|
||||
|
||||
# filter out communities/deleted/suspended/etc
|
||||
my @clean_list; # visible users, not communities
|
||||
foreach my $uid (@$listref) {
|
||||
my $u = $cache->{$uid};
|
||||
next unless $u && $u->{'statusvis'} eq "V" && $u->{'journaltype'} eq "P";
|
||||
push @clean_list, $uid;
|
||||
}
|
||||
|
||||
$listref = \@clean_list;
|
||||
LJ::MemCache::set($memkey, $listref, $LJ::SixDegrees::MEMC_EXPIRE);
|
||||
$cache->{$key} = $listref;
|
||||
return $listref;
|
||||
}
|
||||
|
||||
sub links_out
|
||||
{
|
||||
my $uid = LJ::want_userid($_[0]);
|
||||
return link_fetch($uid, "6dlo:$uid",
|
||||
"SELECT friendid FROM friends WHERE userid=? LIMIT 1000",
|
||||
$_[1]);
|
||||
}
|
||||
|
||||
sub links_in
|
||||
{
|
||||
my $uid = LJ::want_userid($_[0]);
|
||||
return link_fetch($uid, "6dli:$uid",
|
||||
"SELECT userid FROM friends WHERE friendid=? LIMIT 1000",
|
||||
$_[1]);
|
||||
}
|
||||
|
||||
1;
|
||||
158
livejournal/cgi-bin/LJ/SpellCheck.pm
Executable file
158
livejournal/cgi-bin/LJ/SpellCheck.pm
Executable file
@@ -0,0 +1,158 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# LJ::SpellCheck class
|
||||
# See perldoc documentation at the end of this file.
|
||||
#
|
||||
# -------------------------------------------------------------------------
|
||||
#
|
||||
# This package is released under the LGPL (GNU Library General Public License)
|
||||
#
|
||||
# A copy of the license has been included with the software as LGPL.txt.
|
||||
# If not, the license is available at:
|
||||
# http://www.gnu.org/copyleft/library.txt
|
||||
#
|
||||
# -------------------------------------------------------------------------
|
||||
|
||||
|
||||
package LJ::SpellCheck;
|
||||
|
||||
use strict;
|
||||
use FileHandle;
|
||||
use IPC::Open2;
|
||||
use POSIX ":sys_wait_h";
|
||||
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '1.0';
|
||||
|
||||
# Good spellcommand values:
|
||||
# ispell -a -h (default)
|
||||
# /usr/local/bin/aspell pipe -H --sug-mode=fast --ignore-case
|
||||
|
||||
sub new {
|
||||
my ($class, $args) = @_;
|
||||
my $self = {};
|
||||
bless $self, ref $class || $class;
|
||||
|
||||
$self->{'command'} = $args->{'spellcommand'} || "ispell -a -h";
|
||||
$self->{'color'} = $args->{'color'} || "#FF0000";
|
||||
return $self;
|
||||
}
|
||||
|
||||
# This function takes a block of text to spell-check and returns HTML
|
||||
# to show suggesting correction, if any. If the return from this
|
||||
# function is empty, then there were no misspellings found.
|
||||
|
||||
sub check_html {
|
||||
my $self = shift;
|
||||
my $journal = shift;
|
||||
|
||||
my $iread = new FileHandle;
|
||||
my $iwrite = new FileHandle;
|
||||
my $ierr = new FileHandle;
|
||||
my $pid;
|
||||
|
||||
# work-around for mod_perl
|
||||
my $tie_stdin = tied *STDIN;
|
||||
untie *STDIN if $tie_stdin;
|
||||
|
||||
$iwrite->autoflush(1);
|
||||
|
||||
$pid = open2($iread, $iwrite, $self->{'command'}) || die "spell process failed";
|
||||
die "Couldn't find spell checker\n" unless $pid;
|
||||
my $banner = <$iread>;
|
||||
die "banner=$banner\n" unless ($banner =~ /^@\(\#\)/);
|
||||
print $iwrite "!\n";
|
||||
|
||||
my $output = "";
|
||||
my $footnotes = "";
|
||||
|
||||
my ($srcidx, $lineidx, $mscnt, $other_bad);
|
||||
$lineidx = 1;
|
||||
$mscnt = 0;
|
||||
foreach my $inline (split(/\n/, $$journal)) {
|
||||
$srcidx = 0;
|
||||
chomp($inline);
|
||||
print $iwrite "^$inline\n";
|
||||
|
||||
my $idata;
|
||||
do {
|
||||
$idata = <$iread>;
|
||||
chomp($idata);
|
||||
|
||||
if ($idata =~ /^& /) {
|
||||
$idata =~ s/^& (\S+) (\d+) (\d+): //;
|
||||
$mscnt++;
|
||||
my ($word, $sugcount, $ofs) = ($1, $2, $3);
|
||||
$ofs -= 1; # because ispell reports "1" for first character
|
||||
|
||||
$output .= substr($inline, $srcidx, $ofs-$srcidx);
|
||||
$output .= "<font color=\"$self->{'color'}\">$word</font>";
|
||||
|
||||
$footnotes .= "<tr valign=top><td align=right><font color=$self->{'color'}>$word</font></td><td>$idata</td></tr>";
|
||||
|
||||
$srcidx = $ofs + length($word);
|
||||
} elsif ($idata =~ /^\# /) {
|
||||
$other_bad = 1;
|
||||
$idata =~ /^\# (\S+) (\d+)/;
|
||||
my ($word, $ofs) = ($1, $2);
|
||||
$ofs -= 1; # because ispell reports "1" for first character
|
||||
$output .= substr($inline, $srcidx, $ofs-$srcidx);
|
||||
$output .= "<font color=\"$self->{'color'}\">$word</font>";
|
||||
$srcidx = $ofs + length($word);
|
||||
}
|
||||
} while ($idata ne "");
|
||||
$output .= substr($inline, $srcidx, length($inline)-$srcidx) . "<br>\n";
|
||||
$lineidx++;
|
||||
}
|
||||
|
||||
$iread->close;
|
||||
$iwrite->close;
|
||||
|
||||
$pid = waitpid($pid, 0);
|
||||
|
||||
# return mod_perl to previous state, though not necessary?
|
||||
tie *STDIN, $tie_stdin if $tie_stdin;
|
||||
|
||||
return (($mscnt || $other_bad) ? "$output<p><b>Suggestions:</b><table cellpadding=3 border=0>$footnotes</table>" : "");
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
LJ::SpellCheck - let users check spelling on web pages
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use LJ::SpellCheck;
|
||||
my $s = new LJ::SpellCheck { 'spellcommand' => 'ispell -a -h',
|
||||
'color' => '#ff0000',
|
||||
};
|
||||
|
||||
my $text = "Lets mispell thigns!";
|
||||
my $correction = $s->check_html(\$text);
|
||||
if ($correction) {
|
||||
print $correction; # contains a ton of HTML
|
||||
} else {
|
||||
print "No spelling problems.";
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The object constructor takes a 'spellcommand' argument. This has to be some ispell compatible program, like aspell. Optionally, it also takes a color to highlight mispelled words.
|
||||
|
||||
The only method on the object is check_html, which takes a reference to the text to check and returns a bunch of HTML highlighting misspellings and showing suggestions. If it returns nothing, then there no misspellings found.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
Sometimes the opened spell process hangs and eats up tons of CPU. Fixed now, though... I think.
|
||||
|
||||
check_html returns HTML we like. You may not. :)
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
Evan Martin, evan@livejournal.com
|
||||
Brad Fitzpatrick, bradfitz@livejournal.com
|
||||
|
||||
=cut
|
||||
72
livejournal/cgi-bin/LJ/TagGenerator.pm
Executable file
72
livejournal/cgi-bin/LJ/TagGenerator.pm
Executable file
@@ -0,0 +1,72 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
package LJ::TagGenerator;
|
||||
use Carp;
|
||||
|
||||
my %_tag_groups = (
|
||||
":common" => [qw(a b body br code col colgroup dd del div dl dt em
|
||||
font form frame frameset h1 h2 h3 h4 h5 h6 head hr
|
||||
html i img input li nobr ol option p pre table td th
|
||||
tr Tr TR tt title u ul)],
|
||||
":html4" => [qw(a abbr acronym address applet area b base basefont
|
||||
bdo big blockquote body br button caption center cite
|
||||
code col colgroup dd del dfn dir div dl dt em fieldset
|
||||
font form frame frameset h1 h2 h3 h4 h5 h6 head hr html
|
||||
i iframe img input ins isindex kbd label legend li link
|
||||
map menu meta noframes noscript object ol optgroup option
|
||||
p param pre q s samp script select small span strike
|
||||
strong style sub sup table tbody td textarea tfoot th
|
||||
thead title tr Tr TR tt u ul var)],
|
||||
);
|
||||
|
||||
sub import {
|
||||
shift; # ditch the class name
|
||||
my %args = @_;
|
||||
my $tags = $args{tags} || $_tag_groups{":common"};
|
||||
ref $tags and UNIVERSAL::isa($tags, "ARRAY")
|
||||
or croak "Invalid tags argument";
|
||||
my $prefix = $args{prefix} || "";
|
||||
my $suffix = $args{suffix} || "";
|
||||
my $uppercase = $args{uppercase} || 1;
|
||||
my $package = (caller)[0];
|
||||
while (my $tag = shift @$tags) {
|
||||
if (exists $_tag_groups{$tag}) {
|
||||
push @$tags, @{$_tag_groups{$tag}};
|
||||
next;
|
||||
}
|
||||
if ($uppercase) {
|
||||
$tag = uc $tag;
|
||||
}
|
||||
# print "aliasing __$tag to ${package}::$prefix$tag$suffix\n";
|
||||
*{"${package}::$prefix$tag$suffix"} = \&{"__$tag"};
|
||||
}
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
$AUTOLOAD =~ /::__([^:]*)$/ or croak "No such method $AUTOLOAD";
|
||||
my $tagname = lc $1;
|
||||
my $sub = "sub $AUTOLOAD " . q{
|
||||
{
|
||||
my $result = '<__TAGNAME__';
|
||||
if (ref($_[0]) && ref($_[0]) eq 'HASH') {
|
||||
my $attrs = shift;
|
||||
while (my ($key, $value) = each %$attrs) {
|
||||
$key =~ s/^\-//;
|
||||
$key =~ s/_/-/g;
|
||||
$result .= (defined $value ? qq( $key="$value") : qq( $key));
|
||||
}
|
||||
}
|
||||
if (@_) {
|
||||
$result .= ">" . join("", @_) . "</__TAGNAME__>";
|
||||
} else {
|
||||
$result .= " />";
|
||||
}
|
||||
return $result;
|
||||
}
|
||||
};
|
||||
$sub =~ s/__TAGNAME__/$tagname/g;
|
||||
eval $sub;
|
||||
goto &$AUTOLOAD;
|
||||
}
|
||||
|
||||
1;
|
||||
2164
livejournal/cgi-bin/LJ/TextMessage.pm
Executable file
2164
livejournal/cgi-bin/LJ/TextMessage.pm
Executable file
File diff suppressed because it is too large
Load Diff
682
livejournal/cgi-bin/LJ/User.pm
Executable file
682
livejournal/cgi-bin/LJ/User.pm
Executable file
@@ -0,0 +1,682 @@
|
||||
#
|
||||
# LiveJournal user object
|
||||
#
|
||||
# 2004-07-21: we're transition from $u hashrefs to $u objects, currently
|
||||
# backed by hashrefs, to ease migration. in the future,
|
||||
# more methods from ljlib.pl and other places will move here,
|
||||
# and the representation of a $u object will change to 'fields'.
|
||||
# at present, the motivation to moving to $u objects is to do
|
||||
# all database access for a given user through his/her $u object
|
||||
# so the queries can be tagged for use by the star replication
|
||||
# daemon.
|
||||
|
||||
use strict;
|
||||
|
||||
package LJ::User;
|
||||
use Carp;
|
||||
use lib "$ENV{'LJHOME'}/cgi-bin";
|
||||
use LJ::MemCache;
|
||||
|
||||
sub readonly {
|
||||
my $u = shift;
|
||||
return LJ::get_cap($u, "readonly");
|
||||
}
|
||||
|
||||
# returns self (the $u object which can be used for $u->do) if
|
||||
# user is writable, else 0
|
||||
sub writer {
|
||||
my $u = shift;
|
||||
return $u if $u->{'_dbcm'} ||= LJ::get_cluster_master($u);
|
||||
return 0;
|
||||
}
|
||||
|
||||
# returns a true value if the user is underage; or if you give it an argument,
|
||||
# will turn on/off that user's underage status. can also take a second argument
|
||||
# when you're setting the flag to also update the underage_status userprop
|
||||
# which is used to record if a user was ever marked as underage.
|
||||
sub underage {
|
||||
# has no bearing if this isn't on
|
||||
return undef unless $LJ::UNDERAGE_BIT;
|
||||
|
||||
# now get the args and continue
|
||||
my $u = shift;
|
||||
return LJ::get_cap($u, 'underage') unless @_;
|
||||
|
||||
# now set it on or off
|
||||
my $on = shift() ? 1 : 0;
|
||||
if ($on) {
|
||||
LJ::modify_caps($u, [ $LJ::UNDERAGE_BIT ], []);
|
||||
$u->{caps} |= 1 << $LJ::UNDERAGE_BIT;
|
||||
} else {
|
||||
LJ::modify_caps($u, [], [ $LJ::UNDERAGE_BIT ]);
|
||||
$u->{caps} &= !(1 << $LJ::UNDERAGE_BIT);
|
||||
}
|
||||
|
||||
# now set their status flag if one was sent
|
||||
my $status = shift();
|
||||
if ($status || $on) {
|
||||
# by default, just records if user was ever underage ("Y")
|
||||
$u->underage_status($status || 'Y');
|
||||
}
|
||||
|
||||
# add to statushistory
|
||||
if (my $shwhen = shift()) {
|
||||
my $text = $on ? "marked" : "unmarked";
|
||||
my $status = $u->underage_status;
|
||||
LJ::statushistory_add($u, undef, "coppa", "$text; status=$status; when=$shwhen");
|
||||
}
|
||||
|
||||
# now fire off any hooks that are available
|
||||
LJ::run_hooks('set_underage', {
|
||||
u => $u,
|
||||
on => $on,
|
||||
status => $u->underage_status,
|
||||
});
|
||||
|
||||
# return what we set it to
|
||||
return $on;
|
||||
}
|
||||
|
||||
# log a line to our userlog
|
||||
sub log_event {
|
||||
my $u = shift;
|
||||
|
||||
my ($type, $info) = @_;
|
||||
return undef unless $type;
|
||||
$info ||= {};
|
||||
|
||||
# now get variables we need; we use delete to remove them from the hash so when we're
|
||||
# done we can just encode what's left
|
||||
my $ip = delete($info->{ip}) || LJ::get_remote_ip() || undef;
|
||||
my $uniq = delete $info->{uniq};
|
||||
unless ($uniq) {
|
||||
eval {
|
||||
$uniq = Apache->request->notes('uniq');
|
||||
};
|
||||
}
|
||||
my $remote = delete($info->{remote}) || LJ::get_remote() || undef;
|
||||
my $targetid = (delete($info->{actiontarget})+0) || undef;
|
||||
my $extra = %$info ? join('&', map { LJ::eurl($_) . '=' . LJ::eurl($info->{$_}) } keys %$info) : undef;
|
||||
|
||||
# now insert the data we have
|
||||
$u->do("INSERT INTO userlog (userid, logtime, action, actiontarget, remoteid, ip, uniq, extra) " .
|
||||
"VALUES (?, UNIX_TIMESTAMP(), ?, ?, ?, ?, ?, ?)", undef, $u->{userid}, $type,
|
||||
$targetid, $remote ? $remote->{userid} : undef, $ip, $uniq, $extra);
|
||||
return undef if $u->err;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# return or set the underage status userprop
|
||||
sub underage_status {
|
||||
return undef unless $LJ::UNDERAGE_BIT;
|
||||
|
||||
my $u = shift;
|
||||
|
||||
# return if they aren't setting it
|
||||
unless (@_) {
|
||||
LJ::load_user_props($u, 'underage_status');
|
||||
return $u->{underage_status};
|
||||
}
|
||||
|
||||
# set and return what it got set to
|
||||
LJ::set_userprop($u, 'underage_status', shift());
|
||||
return $u->{underage_status};
|
||||
}
|
||||
|
||||
# returns a true value if user has a reserved 'ext' name.
|
||||
sub external {
|
||||
my $u = shift;
|
||||
return $u->{user} =~ /^ext_/;
|
||||
}
|
||||
|
||||
# this is for debugging/special uses where you need to instruct
|
||||
# a user object on what database handle to use. returns the
|
||||
# handle that you gave it.
|
||||
sub set_dbcm {
|
||||
my $u = shift;
|
||||
return $u->{'_dbcm'} = shift;
|
||||
}
|
||||
|
||||
sub begin_work {
|
||||
my $u = shift;
|
||||
return 1 unless $LJ::INNODB_DB{$u->{clusterid}};
|
||||
|
||||
my $dbcm = $u->{'_dbcm'} ||= LJ::get_cluster_master($u)
|
||||
or croak "Database handle unavailable";
|
||||
|
||||
my $rv = $dbcm->begin_work;
|
||||
if ($u->{_dberr} = $dbcm->err) {
|
||||
$u->{_dberrstr} = $dbcm->errstr;
|
||||
}
|
||||
return $rv;
|
||||
}
|
||||
|
||||
sub commit {
|
||||
my $u = shift;
|
||||
return 1 unless $LJ::INNODB_DB{$u->{clusterid}};
|
||||
|
||||
my $dbcm = $u->{'_dbcm'} ||= LJ::get_cluster_master($u)
|
||||
or croak "Database handle unavailable";
|
||||
|
||||
my $rv = $dbcm->commit;
|
||||
if ($u->{_dberr} = $dbcm->err) {
|
||||
$u->{_dberrstr} = $dbcm->errstr;
|
||||
}
|
||||
return $rv;
|
||||
}
|
||||
|
||||
sub rollback {
|
||||
my $u = shift;
|
||||
return 0 unless $LJ::INNODB_DB{$u->{clusterid}};
|
||||
|
||||
my $dbcm = $u->{'_dbcm'} ||= LJ::get_cluster_master($u)
|
||||
or croak "Database handle unavailable";
|
||||
|
||||
my $rv = $dbcm->rollback;
|
||||
if ($u->{_dberr} = $dbcm->err) {
|
||||
$u->{_dberrstr} = $dbcm->errstr;
|
||||
}
|
||||
return $rv;
|
||||
}
|
||||
|
||||
# get an $sth from the writer
|
||||
sub prepare {
|
||||
my $u = shift;
|
||||
|
||||
my $dbcm = $u->{'_dbcm'} ||= LJ::get_cluster_master($u)
|
||||
or croak "Database handle unavailable";
|
||||
|
||||
my $rv = $dbcm->prepare(@_);
|
||||
if ($u->{_dberr} = $dbcm->err) {
|
||||
$u->{_dberrstr} = $dbcm->errstr;
|
||||
}
|
||||
return $rv;
|
||||
}
|
||||
|
||||
# $u->do("UPDATE foo SET key=?", undef, $val);
|
||||
sub do {
|
||||
my $u = shift;
|
||||
my $query = shift;
|
||||
|
||||
my $uid = $u->{userid}+0
|
||||
or croak "Database update called on null user object";
|
||||
|
||||
my $dbcm = $u->{'_dbcm'} ||= LJ::get_cluster_master($u)
|
||||
or croak "Database handle unavailable";
|
||||
|
||||
$query =~ s!^(\s*\w+\s+)!$1/* uid=$uid */ !;
|
||||
|
||||
my $rv = $dbcm->do($query, @_);
|
||||
if ($u->{_dberr} = $dbcm->err) {
|
||||
$u->{_dberrstr} = $dbcm->errstr;
|
||||
}
|
||||
|
||||
$u->{_mysql_insertid} = $dbcm->{'mysql_insertid'} if $dbcm->{'mysql_insertid'};
|
||||
|
||||
return $rv;
|
||||
}
|
||||
|
||||
sub selectrow_array {
|
||||
my $u = shift;
|
||||
my $dbcm = $u->{'_dbcm'} ||= LJ::get_cluster_master($u)
|
||||
or croak "Database handle unavailable";
|
||||
return $dbcm->selectrow_array(@_);
|
||||
}
|
||||
|
||||
sub selectrow_hashref {
|
||||
my $u = shift;
|
||||
my $dbcm = $u->{'_dbcm'} ||= LJ::get_cluster_master($u)
|
||||
or croak "Database handle unavailable";
|
||||
return $dbcm->selectrow_hashref(@_);
|
||||
}
|
||||
|
||||
sub err {
|
||||
my $u = shift;
|
||||
return $u->{_dberr};
|
||||
}
|
||||
|
||||
sub errstr {
|
||||
my $u = shift;
|
||||
return $u->{_dberrstr};
|
||||
}
|
||||
|
||||
sub quote {
|
||||
my $u = shift;
|
||||
my $text = shift;
|
||||
|
||||
my $dbcm = $u->{'_dbcm'} ||= LJ::get_cluster_master($u)
|
||||
or croak "Database handle unavailable";
|
||||
|
||||
return $dbcm->quote($text);
|
||||
}
|
||||
|
||||
sub mysql_insertid {
|
||||
my $u = shift;
|
||||
if ($u->isa("LJ::User")) {
|
||||
return $u->{_mysql_insertid};
|
||||
} elsif (LJ::isdb($u)) {
|
||||
my $db = $u;
|
||||
return $db->{'mysql_insertid'};
|
||||
} else {
|
||||
die "Unknown object '$u' being passed to LJ::User::mysql_insertid.";
|
||||
}
|
||||
}
|
||||
|
||||
# <LJFUNC>
|
||||
# name: LJ::User::dudata_set
|
||||
# class: logging
|
||||
# des: Record or delete disk usage data for a journal
|
||||
# args: u, area, areaid, bytes
|
||||
# area: One character: "L" for log, "T" for talk, "B" for bio, "P" for pic.
|
||||
# areaid: Unique ID within $area, or '0' if area has no ids (like bio)
|
||||
# bytes: Number of bytes item takes up. Or 0 to delete record.
|
||||
# returns: 1.
|
||||
# </LJFUNC>
|
||||
sub dudata_set {
|
||||
my ($u, $area, $areaid, $bytes) = @_;
|
||||
$bytes += 0; $areaid += 0;
|
||||
if ($bytes) {
|
||||
$u->do("REPLACE INTO dudata (userid, area, areaid, bytes) ".
|
||||
"VALUES (?, ?, $areaid, $bytes)", undef,
|
||||
$u->{userid}, $area);
|
||||
} else {
|
||||
$u->do("DELETE FROM dudata WHERE userid=? AND ".
|
||||
"area=? AND areaid=$areaid", undef,
|
||||
$u->{userid}, $area);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub generate_session
|
||||
{
|
||||
my ($u, $opts) = @_;
|
||||
my $udbh = LJ::get_cluster_master($u);
|
||||
return undef unless $udbh;
|
||||
|
||||
# clean up any old, expired sessions they might have (lazy clean)
|
||||
$u->do("DELETE FROM sessions WHERE userid=? AND timeexpire < UNIX_TIMESTAMP()",
|
||||
undef, $u->{userid});
|
||||
|
||||
my $sess = {};
|
||||
$opts->{'exptype'} = "short" unless $opts->{'exptype'} eq "long" ||
|
||||
$opts->{'exptype'} eq "once";
|
||||
$sess->{'auth'} = LJ::rand_chars(10);
|
||||
my $expsec = $opts->{'expsec'}+0 || {
|
||||
'short' => 60*60*24*1.5, # 36 hours
|
||||
'long' => 60*60*24*60, # 60 days
|
||||
'once' => 60*60*24*1.5, # same as short; just doesn't renew
|
||||
}->{$opts->{'exptype'}};
|
||||
my $id = LJ::alloc_user_counter($u, 'S');
|
||||
return undef unless $id;
|
||||
$u->do("REPLACE INTO sessions (userid, sessid, auth, exptype, ".
|
||||
"timecreate, timeexpire, ipfixed) VALUES (?,?,?,?,UNIX_TIMESTAMP(),".
|
||||
"UNIX_TIMESTAMP()+$expsec,?)", undef,
|
||||
$u->{'userid'}, $id, $sess->{'auth'}, $opts->{'exptype'}, $opts->{'ipfixed'});
|
||||
return undef if $u->err;
|
||||
$sess->{'sessid'} = $id;
|
||||
$sess->{'userid'} = $u->{'userid'};
|
||||
$sess->{'ipfixed'} = $opts->{'ipfixed'};
|
||||
$sess->{'exptype'} = $opts->{'exptype'};
|
||||
|
||||
# clean up old sessions
|
||||
my $old = $udbh->selectcol_arrayref("SELECT sessid FROM sessions WHERE ".
|
||||
"userid=$u->{'userid'} AND ".
|
||||
"timeexpire < UNIX_TIMESTAMP()");
|
||||
$u->kill_sessions(@$old) if $old;
|
||||
|
||||
# mark account as being used
|
||||
LJ::mark_user_active($u, 'login');
|
||||
|
||||
return $sess;
|
||||
}
|
||||
|
||||
sub make_login_session {
|
||||
my ($u, $exptype, $ipfixed) = @_;
|
||||
$exptype ||= 'short';
|
||||
return 0 unless $u;
|
||||
|
||||
my $etime = 0;
|
||||
eval { Apache->request->notes('ljuser' => $u->{'user'}); };
|
||||
|
||||
my $sess = $u->generate_session({
|
||||
'exptype' => $exptype,
|
||||
'ipfixed' => $ipfixed,
|
||||
});
|
||||
$BML::COOKIE{'ljsession'} = [ "ws:$u->{'user'}:$sess->{'sessid'}:$sess->{'auth'}", $etime, 1 ];
|
||||
LJ::set_remote($u);
|
||||
|
||||
LJ::load_user_props($u, "browselang", "schemepref" );
|
||||
my $bl = LJ::Lang::get_lang($u->{'browselang'});
|
||||
if ($bl) {
|
||||
BML::set_cookie("langpref", $bl->{'lncode'} . "/" . time(), 0, $LJ::COOKIE_PATH, $LJ::COOKIE_DOMAIN);
|
||||
BML::set_language($bl->{'lncode'});
|
||||
}
|
||||
|
||||
# restore default scheme
|
||||
if ($u->{'schemepref'} ne "") {
|
||||
BML::set_cookie("BMLschemepref", $u->{'schemepref'}, 0, $LJ::COOKIE_PATH, $LJ::COOKIE_DOMAIN);
|
||||
BML::set_scheme($u->{'schemepref'});
|
||||
}
|
||||
|
||||
LJ::run_hooks("post_login", {
|
||||
"u" => $u,
|
||||
"form" => {},
|
||||
"expiretime" => $etime,
|
||||
});
|
||||
|
||||
LJ::mark_user_active($u, 'login');
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub tosagree_set
|
||||
{
|
||||
my ($u, $err) = @_;
|
||||
return undef unless $u;
|
||||
|
||||
unless (-f "$LJ::HOME/htdocs/inc/legal-tos") {
|
||||
$$err = "TOS include file could not be found";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $rev;
|
||||
open (TOS, "$LJ::HOME/htdocs/inc/legal-tos");
|
||||
while ((!$rev) && (my $line = <TOS>)) {
|
||||
my $rcstag = "Revision";
|
||||
if ($line =~ /\$$rcstag:\s*(\S+)\s*\$/) {
|
||||
$rev = $1;
|
||||
}
|
||||
}
|
||||
close TOS;
|
||||
|
||||
# if the required version of the tos is not available, error!
|
||||
my $rev_req = $LJ::REQUIRED_TOS{rev};
|
||||
if ($rev_req > 0 && $rev ne $rev_req) {
|
||||
$$err = "Required Terms of Service revision is $rev_req, but system version is $rev.";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $newval = join(', ', time(), $rev);
|
||||
my $rv = LJ::set_userprop($u, "legal_tosagree", $newval);
|
||||
|
||||
# set in $u object for callers later
|
||||
$u->{legal_tosagree} = $newval if $rv;
|
||||
|
||||
return $rv;
|
||||
}
|
||||
|
||||
sub tosagree_verify {
|
||||
my $u = shift;
|
||||
|
||||
return 1 unless $LJ::TOS_CHECK;
|
||||
|
||||
my $rev_req = $LJ::REQUIRED_TOS{rev};
|
||||
return 1 unless $rev_req > 0;
|
||||
|
||||
LJ::load_user_props($u, 'legal_tosagree')
|
||||
unless $u->{legal_tosagree};
|
||||
|
||||
my $rev_cur = (split(/\s*,\s*/, $u->{legal_tosagree}))[1];
|
||||
|
||||
return $rev_cur eq $rev_req;
|
||||
}
|
||||
|
||||
sub kill_sessions {
|
||||
my $u = shift;
|
||||
my (@sessids) = @_;
|
||||
my $in = join(',', map { $_+0 } @sessids);
|
||||
return 1 unless $in;
|
||||
my $userid = $u->{'userid'};
|
||||
foreach (qw(sessions sessions_data)) {
|
||||
$u->do("DELETE FROM $_ WHERE userid=? AND ".
|
||||
"sessid IN ($in)", undef, $userid);
|
||||
}
|
||||
foreach my $id (@sessids) {
|
||||
$id += 0;
|
||||
my $memkey = [$userid,"sess:$userid:$id"];
|
||||
LJ::MemCache::delete($memkey);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub kill_all_sessions {
|
||||
my $u = shift;
|
||||
return 0 unless $u;
|
||||
my $udbh = LJ::get_cluster_master($u);
|
||||
my $sessions = $udbh->selectcol_arrayref("SELECT sessid FROM sessions WHERE ".
|
||||
"userid=$u->{'userid'}");
|
||||
$u->kill_sessions(@$sessions) if @$sessions;
|
||||
|
||||
# forget this user, if we knew they were logged in
|
||||
delete $BML::COOKIE{'ljsession'};
|
||||
LJ::set_remote(undef) if
|
||||
$LJ::CACHE_REMOTE &&
|
||||
$LJ::CACHE_REMOTE->{userid} == $u->{userid};
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub kill_session {
|
||||
my $u = shift;
|
||||
return 0 unless $u;
|
||||
return 0 unless exists $u->{'_session'};
|
||||
$u->kill_sessions($u->{'_session'}->{'sessid'});
|
||||
|
||||
# forget this user, if we knew they were logged in
|
||||
delete $BML::COOKIE{'ljsession'};
|
||||
LJ::set_remote(undef) if
|
||||
$LJ::CACHE_REMOTE &&
|
||||
$LJ::CACHE_REMOTE->{userid} == $u->{userid};
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# <LJFUNC>
|
||||
# name: LJ::User::mogfs_userpic_key
|
||||
# class: mogilefs
|
||||
# des: Make a mogilefs key for the given pic for the user
|
||||
# args: pic
|
||||
# pic: Either the userpic hash or the picid of the userpic.
|
||||
# returns: 1.
|
||||
# </LJFUNC>
|
||||
sub mogfs_userpic_key {
|
||||
my $self = shift or return undef;
|
||||
my $pic = shift or croak "missing required arg: userpic";
|
||||
|
||||
my $picid = ref $pic ? $pic->{picid} : $pic+0;
|
||||
return "up:$self->{userid}:$picid";
|
||||
}
|
||||
|
||||
# all reads/writes to talk2 must be done inside a lock, so there's
|
||||
# no race conditions between reading from db and putting in memcache.
|
||||
# can't do a db write in between those 2 steps. the talk2 -> memcache
|
||||
# is elsewhere (talklib.pl), but this $dbh->do wrapper is provided
|
||||
# here because non-talklib things modify the talk2 table, and it's
|
||||
# nice to centralize the locking rules.
|
||||
#
|
||||
# return value is return of $dbh->do. $errref scalar ref is optional, and
|
||||
# if set, gets value of $dbh->errstr
|
||||
#
|
||||
# write: (LJ::talk2_do)
|
||||
# GET_LOCK
|
||||
# update/insert into talk2
|
||||
# RELEASE_LOCK
|
||||
# delete memcache
|
||||
#
|
||||
# read: (LJ::Talk::get_talk_data)
|
||||
# try memcache
|
||||
# GET_LOCk
|
||||
# read db
|
||||
# update memcache
|
||||
# RELEASE_LOCK
|
||||
|
||||
sub talk2_do {
|
||||
my ($u, $nodetype, $nodeid, $errref, $sql, @args) = @_;
|
||||
return undef unless $nodetype =~ /^\w$/;
|
||||
return undef unless $nodeid =~ /^\d+$/;
|
||||
return undef unless $u->writer;
|
||||
|
||||
my $dbcm = $u->{_dbcm};
|
||||
|
||||
my $memkey = [$u->{'userid'}, "talk2:$u->{'userid'}:$nodetype:$nodeid"];
|
||||
my $lockkey = $memkey->[1];
|
||||
|
||||
$dbcm->selectrow_array("SELECT GET_LOCK(?,10)", undef, $lockkey);
|
||||
my $ret = $u->do($sql, undef, @args);
|
||||
$$errref = $u->errstr if ref $errref && $u->err;
|
||||
$dbcm->selectrow_array("SELECT RELEASE_LOCK(?)", undef, $lockkey);
|
||||
|
||||
LJ::MemCache::delete($memkey, 0) if int($ret);
|
||||
return $ret;
|
||||
}
|
||||
|
||||
# log2_do
|
||||
# see comments for talk2_do
|
||||
|
||||
sub log2_do {
|
||||
my ($u, $errref, $sql, @args) = @_;
|
||||
return undef unless $u->writer;
|
||||
|
||||
my $dbcm = $u->{_dbcm};
|
||||
|
||||
my $memkey = [$u->{'userid'}, "log2lt:$u->{'userid'}"];
|
||||
my $lockkey = $memkey->[1];
|
||||
|
||||
$dbcm->selectrow_array("SELECT GET_LOCK(?,10)", undef, $lockkey);
|
||||
my $ret = $u->do($sql, undef, @args);
|
||||
$$errref = $u->errstr if ref $errref && $u->err;
|
||||
$dbcm->selectrow_array("SELECT RELEASE_LOCK(?)", undef, $lockkey);
|
||||
|
||||
LJ::MemCache::delete($memkey, 0) if int($ret);
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub url {
|
||||
my $u = shift;
|
||||
LJ::load_user_props($u, "url");
|
||||
if ($u->{'journaltype'} eq "I" && ! $u->{url}) {
|
||||
my $id = $u->identity;
|
||||
if ($id && $id->[0] eq "O") {
|
||||
LJ::set_userprop($u, "url", $id->[1]) if $id->[1];
|
||||
return $id->[1];
|
||||
}
|
||||
}
|
||||
return $u->{url};
|
||||
}
|
||||
|
||||
# returns arrayref of [idtype, identity]
|
||||
sub identity {
|
||||
my $u = shift;
|
||||
return $u->{_identity} if $u->{_identity};
|
||||
return undef unless $u->{'journaltype'} eq "I";
|
||||
my $memkey = [$u->{userid}, "ident:$u->{userid}"];
|
||||
my $ident = LJ::MemCache::get($memkey);
|
||||
if ($ident) {
|
||||
return $u->{_identity} = $ident;
|
||||
}
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
$ident = $dbh->selectrow_arrayref("SELECT idtype, identity FROM identitymap ".
|
||||
"WHERE userid=? LIMIT 1", undef, $u->{userid});
|
||||
if ($ident) {
|
||||
LJ::MemCache::set($memkey, $ident);
|
||||
return $ident;
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
# returns a URL iff account is an OpenID identity. undef otherwise.
|
||||
sub openid_identity {
|
||||
my $u = shift;
|
||||
my $ident = $u->identity;
|
||||
return undef unless $ident && $ident->[0] == 0;
|
||||
return $ident->[1];
|
||||
}
|
||||
|
||||
# returns username or identity display name, not escaped
|
||||
sub display_name {
|
||||
my $u = shift;
|
||||
return $u->{'user'} unless $u->{'journaltype'} eq "I";
|
||||
|
||||
my $id = $u->identity;
|
||||
return "[ERR:unknown_identity]" unless $id;
|
||||
|
||||
my ($url, $name);
|
||||
if ($id->[0] eq "O") {
|
||||
require Net::OpenID::Consumer;
|
||||
$url = $id->[1];
|
||||
$name = Net::OpenID::VerifiedIdentity::DisplayOfURL($url, $LJ::IS_DEV_SERVER);
|
||||
# FIXME: make a good out of this
|
||||
$name =~ s/\[(live|dead)journal\.com/\[${1}journal/;
|
||||
}
|
||||
return $name;
|
||||
}
|
||||
|
||||
sub ljuser_display {
|
||||
my $u = shift;
|
||||
my $opts = shift;
|
||||
|
||||
return LJ::ljuser($u, $opts) unless $u->{'journaltype'} eq "I";
|
||||
|
||||
my $id = $u->identity;
|
||||
return "<b>????</b>" unless $id;
|
||||
|
||||
my $andfull = $opts->{'full'} ? "&mode=full" : "";
|
||||
my $img = $opts->{'imgroot'} || $LJ::IMGPREFIX;
|
||||
my $strike = $opts->{'del'} ? ' text-decoration: line-through;' : '';
|
||||
|
||||
my ($url, $name);
|
||||
|
||||
if ($id->[0] eq "O") {
|
||||
$url = $id->[1];
|
||||
$name = $u->display_name;
|
||||
|
||||
$url ||= "about:blank";
|
||||
$name ||= "[no_name]";
|
||||
|
||||
$url = LJ::ehtml($url);
|
||||
$name = LJ::ehtml($name);
|
||||
|
||||
return "<span class='ljuser' style='white-space: nowrap;'><a href='$LJ::SITEROOT/userinfo.bml?userid=$u->{userid}&t=I$andfull'><img src='$img/openid-profile.gif' alt='[info]' width='16' height='16' style='vertical-align: bottom; border: 0;' /></a><a href='$url' rel='nofollow'><b>$name</b></a></span>";
|
||||
|
||||
} else {
|
||||
return "<b>????</b>";
|
||||
}
|
||||
}
|
||||
|
||||
sub load_identity_user {
|
||||
my ($type, $ident, $vident) = @_;
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
my $uid = $dbh->selectrow_array("SELECT userid FROM identitymap WHERE idtype=? AND identity=?",
|
||||
undef, $type, $ident);
|
||||
return LJ::load_userid($uid) if $uid;
|
||||
|
||||
# increment ext_ counter until we successfully create an LJ
|
||||
# account. hard cap it at 10 tries. (arbitrary, but we really
|
||||
# shouldn't have *any* failures here, let alone 10 in a row)
|
||||
|
||||
for (1..10) {
|
||||
my $extuser = 'ext_' . LJ::alloc_global_counter('E');
|
||||
|
||||
my $name = $extuser;
|
||||
if ($type eq "O" && ref $vident) {
|
||||
$name = $vident->display;
|
||||
}
|
||||
|
||||
$uid = LJ::create_account({
|
||||
caps => undef,
|
||||
user => $extuser,
|
||||
name => $name,
|
||||
journaltype => 'I',
|
||||
});
|
||||
last if $uid;
|
||||
select undef, undef, undef, .10; # lets not thrash over this
|
||||
}
|
||||
return undef unless $uid &&
|
||||
$dbh->do("INSERT INTO identitymap (idtype, identity, userid) VALUES (?,?,?)",
|
||||
undef, $type, $ident, $uid);
|
||||
return LJ::load_userid($uid);
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user