1560 lines
52 KiB
Perl
Executable File
1560 lines
52 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# LiveJournal.com-specific library
|
|
#
|
|
# This file is NOT licensed under the GPL. As with everything in the
|
|
# "ljcom" CVS repository, this file is the property of Danga
|
|
# Interactive and is made available to the public only as a reference
|
|
# as to the best way to modify/extend the base LiveJournal server code
|
|
# (which is licensed under the GPL).
|
|
#
|
|
# Feel free to read and learn from things in "ljcom", but don't use it verbatim
|
|
# because we don't want your site looking like LiveJournal.com (our logo
|
|
# and site scheme are our identity and we don't want to confuse users)
|
|
# and we're sick of getting everybody's payment notifications when
|
|
# they use our payment system without any modifications.
|
|
#
|
|
|
|
#BEGIN {
|
|
# # kill the LJ definition of LJ::is_utf8 so we can override it without warnings
|
|
# {
|
|
# no strict;
|
|
# local $^W = 0;
|
|
# *stab = *{"main::LJ::"};
|
|
# undef $stab{is_utf8};
|
|
# }
|
|
#
|
|
#}
|
|
|
|
#@LJ::USER_TABLES_LOCAL = ("phonepostentry", "phoneposttrans");
|
|
|
|
$LJ::BML_DENY_CONFIG = "guide, clients, files";
|
|
|
|
#$LJ::ACCOUNTS_EMAIL = "accounts\@lj.rossia.org";
|
|
|
|
%LJ::FIXED_ALIAS = (
|
|
'lj' => 'lj', # discarded
|
|
'lj_notify' => 'lj', # also discarded
|
|
'webmaster' => 'lj',
|
|
'support' => 'lj',
|
|
'abuse' => 'lj',
|
|
'privacy' => 'lj',
|
|
'feedback' => 'lj',
|
|
'press' => 'lj',
|
|
'accounts' => 'lj'
|
|
);
|
|
|
|
#@LJ::LANGS = qw(en_LJ en_GB de da es fr it ru ja pt eo he nl hu ga is fi nb sv pl zh lv tr ms)
|
|
# unless @LJ::LANGS > 1;
|
|
|
|
# Useful untainting regexen
|
|
%LJ::REGEX = (
|
|
httpuri => qr{(http://(?:(?:(?:(?:(?:[a-zA-Z\d](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?)\.)*(?:[a-zA-Z](?:(?:[a-zA-Z\d]|-)*[a-zA-Z\d])?))|(?:(?:\d+)(?:\.(?:\d+)){3}))(?::(?:\d+))?)(?:/(?:(?:(?:(?:[a-zA-Z\d\$\_.+!*'(),-]|(?:%[a-fA-F\d]{2}))|[;:@&=])*)(?:/(?:(?:(?:[a-zA-Z\d\$\_.+!*'(),-]|(?:%[a-fA-F\d]{2}))|[;:@&=])*))*)(?:\?(?:(?:(?:[a-zA-Z\d\$\_.+!*'(),-]|(?:%[a-fA-F\d]{2}))|[;:@&=])*))?)?)}x,
|
|
#'
|
|
);
|
|
|
|
|
|
package LJ::Contrib;
|
|
|
|
# is the given user an acked contributor themselves?
|
|
sub is_acked
|
|
{
|
|
my ($userid) = @_;
|
|
my $dbr = LJ::get_db_reader();
|
|
return undef unless $dbr and $userid;
|
|
return $dbr->selectrow_array("SELECT COUNT(*) FROM contributed WHERE userid=? AND acks > 0",
|
|
undef, $userid);
|
|
}
|
|
|
|
# make $coid acked by $userid
|
|
sub ack
|
|
{
|
|
my ($coid, $userid) = @_;
|
|
my $dbh = LJ::get_db_writer();
|
|
return undef unless $dbh and $userid and $coid;
|
|
|
|
# see if contribution exists
|
|
my $co = $dbh->selectrow_hashref("SELECT * FROM contributed WHERE coid=?",
|
|
undef, $coid);
|
|
return 0 unless $co;
|
|
|
|
## Lock the Tables
|
|
$dbh->do("LOCK TABLES contributedack WRITE, contributed WRITE");
|
|
|
|
## add the ack
|
|
$dbh->do("REPLACE INTO contributedack (coid, ackuserid) VALUES (?,?)",
|
|
undef, $coid, $userid);
|
|
|
|
## see how many acks it has now.
|
|
my $newcount = $dbh->selectrow_array("SELECT COUNT(*) FROM contributedack WHERE coid=?",
|
|
undef, $coid);
|
|
$newcount += 0;
|
|
|
|
## update the contributed table
|
|
$dbh->do("UPDATE contributed SET acks=? WHERE coid=?", undef,
|
|
$newcount, $coid);
|
|
|
|
## Unlock tables
|
|
$dbh->do("UNLOCK TABLES");
|
|
return 1;
|
|
}
|
|
|
|
package LJ::LJcom;
|
|
|
|
use Inline (C => 'DATA',
|
|
DIRECTORY => $ENV{LJ_INLINE_DIR} || "$ENV{'LJHOME'}/Inline",
|
|
);
|
|
use strict;
|
|
|
|
{
|
|
eval {
|
|
Inline->init();
|
|
};
|
|
if ($@) {
|
|
die "You seem to have Inline.pm, but you haven't run \$LJHOME/bin/lj-inline.pl\n";
|
|
}
|
|
}
|
|
|
|
sub country_of_ip {
|
|
my $ip = shift;
|
|
return undef unless $LJ::OPTMOD_GEOIP;
|
|
my $gi = $LJ::CACHE_GEOIP_HANDLE ||= Geo::IP::PurePerl->open("$LJ::HOME/cgi-bin/GeoIP.dat");
|
|
return $gi->country_code_by_addr($ip);
|
|
}
|
|
|
|
# old-name (off, on, paid, early (& new))
|
|
sub acct_name_short {
|
|
my $caps = shift;
|
|
if ($caps & 0x10) {
|
|
return "on";
|
|
} elsif ($caps & 0x08) {
|
|
return "paid";
|
|
} elsif ($caps & 0x04) {
|
|
return "early";
|
|
} elsif ($caps & 0x02) {
|
|
return "off";
|
|
} elsif ($caps & 0x01) {
|
|
return "new";
|
|
}
|
|
return "??";
|
|
}
|
|
|
|
sub acct_name {
|
|
my $caps = shift;
|
|
my $paiduntil = shift;
|
|
|
|
my $v;
|
|
if ($paiduntil)
|
|
{
|
|
$v = $caps & 0x08 && $caps & 0x04 ?
|
|
BML::ml('ljcom.userinfo.types.paid_early_expiring', { 'paiduntil' => $paiduntil }) :
|
|
BML::ml('ljcom.userinfo.types.paid_expiring', { 'paiduntil' => $paiduntil });
|
|
} else {
|
|
$v = $caps & 0x10 && $caps & 0x04 ?
|
|
$BML::ML{'ljcom.userinfo.types.permanent_early'} :
|
|
$caps & 0x10 ? $BML::ML{'ljcom.userinfo.types.permanent'} :
|
|
$caps & 0x08 && $caps & 0x04 ?
|
|
$BML::ML{'ljcom.userinfo.types.paid_early'} :
|
|
$caps & 0x08 ? $BML::ML{'ljcom.userinfo.types.paid'} :
|
|
$caps & 0x04 ? $BML::ML{'ljcom.userinfo.types.early'} :
|
|
$caps & 0x02 ? $BML::ML{'ljcom.userinfo.types.free'} :
|
|
$caps & 0x01 ? $BML::ML{'ljcom.userinfo.types.trial'} :
|
|
undef;
|
|
}
|
|
return $v;
|
|
}
|
|
|
|
sub is_goatvote_poll {
|
|
my ($po, $qs) = @_;
|
|
|
|
# to be a goatvote poll:
|
|
# the name must have "GoatVote:" prepended
|
|
# the poster must have siteadmin:goatvote
|
|
# after that, we don't care. but if a poll is in this format, we can process
|
|
# the data as if it's a goatvote poll.
|
|
|
|
# load the questions
|
|
return 0 unless $po->{name} =~ /^GoatVote:/i;
|
|
|
|
# now check user permissions
|
|
my $u = LJ::load_userid($po->{posterid});
|
|
return 0 unless LJ::check_priv($u, 'siteadmin', 'goatvote');
|
|
|
|
# now make sure the format is right
|
|
@$qs = sort { $a->{pollqid} <=> $b->{pollqid} } @$qs;
|
|
|
|
# check one two...
|
|
return 0 unless scalar @$qs >= 2;
|
|
return 0 unless $qs->[0]{type} eq 'radio';
|
|
return 0 unless $qs->[1]{type} eq 'text';
|
|
|
|
# okay, it is!
|
|
return 1;
|
|
}
|
|
|
|
sub expresslane_html_comment {
|
|
my ($u, $r) = @_;
|
|
return '' unless $r && $u && LJ::get_cap($u, 'paid');
|
|
|
|
my ($free_ct, $free_age) = ($r->header_in('X-Queue-Count')+0, $r->header_in('X-Queue-Age')+0);
|
|
return "<!-- LiveJournal ExpressLane: You received this page before $free_ct free users" .
|
|
($free_age > 0 ? ", saving approximately $free_age seconds" : '') . "! -->\n";
|
|
};
|
|
|
|
#LJ::register_setter("latest_optout", sub {
|
|
# &LJ::nodb;
|
|
# my ($u, $remote, $key, $value, $err) = @_;
|
|
#
|
|
# unless ($value =~ /^(?:yes|no)$/i) {
|
|
# $$err = "Illegal value. Must be 'yes' or 'no'.";
|
|
# return 0;
|
|
# }
|
|
#
|
|
# $value = lc $value eq 'yes' ? 1 : 0;
|
|
# LJ::set_userprop($u, "latest_optout", $value);
|
|
# return 1;
|
|
#});
|
|
|
|
LJ::register_setter("no_mail_alias", sub {
|
|
&LJ::nodb;
|
|
my ($u, $remote, $key, $value, $err) = @_;
|
|
|
|
my $dbh = LJ::get_db_writer();
|
|
|
|
unless ($value =~ /^[01]$/) {
|
|
$$err = "Illegal value. Must be '0' or '1'.";
|
|
return 0;
|
|
}
|
|
|
|
if ($value) {
|
|
$dbh->do("DELETE FROM email_aliases WHERE alias=?", undef,
|
|
"$u->{'user'}\@$LJ::USER_DOMAIN");
|
|
} elsif ($u->{'status'} eq "A" && LJ::get_cap($u, "useremail")) {
|
|
$dbh->do("REPLACE INTO email_aliases (alias, rcpt) VALUES (?,?)",
|
|
undef, "$u->{'user'}\@$LJ::USER_DOMAIN", $u->{'email'});
|
|
}
|
|
|
|
LJ::set_userprop($u, "no_mail_alias", $value);
|
|
return 1;
|
|
});
|
|
|
|
LJ::clear_hooks();
|
|
|
|
LJ::register_hook("name_caps", \&acct_name);
|
|
LJ::register_hook("name_caps_short", \&acct_name_short);
|
|
LJ::register_hook('s2_head_content_extra', \&expresslane_html_comment);
|
|
|
|
# if a user gets marked underage, we need to clear out their personally
|
|
# identifying information
|
|
#LJ::register_hook('set_underage', sub {
|
|
# my $opts = shift;
|
|
# return unless $opts->{on}; # only care if turned on
|
|
#
|
|
# # update records in the user table
|
|
# my $u = $opts->{u};
|
|
# LJ::update_user($u, {
|
|
# name => $u->{user},
|
|
# bdate => undef,
|
|
# allow_infoshow => 'N',
|
|
# allow_contactshow => 'N',
|
|
# has_bio => 'N',
|
|
# txtmsg_status => 'off',
|
|
# status => 'T',
|
|
# });
|
|
|
|
# # the only thing we have left on
|
|
# return if $u->{statusvis} eq 'X';
|
|
#
|
|
# # now empty their bio information
|
|
# $u->do("DELETE FROM userbio WHERE userid=?", undef, $u->{'userid'});
|
|
# $u->dudata_set('B', 0, 0);
|
|
#
|
|
# # clear a ton of userprops
|
|
# my @toclear = qw(
|
|
# country state city zip icq aolim yahoo msn
|
|
# url urlname gender jabber journaltitle journalsubtitle
|
|
# friendspagetitle external_foaf_url
|
|
# );
|
|
# foreach my $prop (@toclear) {
|
|
# LJ::set_userprop($u, $prop, undef);
|
|
# }
|
|
#});
|
|
|
|
# hook to handle creating a button to email someone about spam
|
|
LJ::register_hook('spamreport_notification', sub {
|
|
my ($remote, $opts) = @_;
|
|
|
|
# they can send in either 'ip => foo' or 'posterid => foo' but we
|
|
# only care about posterid for now
|
|
my $posterid;
|
|
return unless $posterid = $opts->{posterid};
|
|
my $poster = LJ::want_user($posterid);
|
|
|
|
# verify we got the remote user and a poster
|
|
$remote = LJ::want_user($remote);
|
|
return undef unless $remote && $poster;
|
|
|
|
if ($poster->openid_identity) {
|
|
return "<p><span style='color: red;'>WARNING:</span> The account you are viewing (" .
|
|
LJ::ljuser($poster) . ") is an OpenID identity and has no email address.</p>";
|
|
}
|
|
|
|
# step 1) find related users by email
|
|
my $dbr = LJ::get_db_reader();
|
|
return "<?p Database temporarily unavailable, unable to check warning status. p?>"
|
|
unless $dbr;
|
|
my $users = $dbr->selectall_hashref('SELECT * FROM user WHERE email = ?', 'userid', undef, $poster->{email});
|
|
return "<?p Error: no users found matching poster's email address. p?>"
|
|
unless $users && ref $users eq 'HASH' && %$users;
|
|
|
|
# now see if any of these have been warned
|
|
my $in = join(',', map { ref $_ ? ($_->{userid} + 0) : 0 } values %$users);
|
|
my $warnings = $dbr->selectall_arrayref("SELECT adminid, shdate, userid FROM statushistory " .
|
|
"WHERE userid IN ($in) AND shtype = 'spam_warning'");
|
|
return "<?p Database error checking for previous warnings. p?>"
|
|
if $dbr->err || !defined $warnings;
|
|
|
|
# now construct html
|
|
my ($ret, %emailcounts, %emails);
|
|
foreach my $warning (@$warnings) {
|
|
my $date = $warning->[1];
|
|
if ($date =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/) {
|
|
$date = "$1-$2-$3 $4:$5:$6";
|
|
}
|
|
my $admin = LJ::load_userid($warning->[0]);
|
|
my $warned = LJ::load_userid($warning->[2]);
|
|
|
|
# come up with notes about this warning
|
|
my $notes = 'none';
|
|
if (LJ::u_equals($poster, $warned)) {
|
|
$notes = 'user match';
|
|
} elsif (lc $poster->{email} eq lc $warned->{email}) {
|
|
$notes = 'email match';
|
|
if ($warned->{status} ne 'A') {
|
|
$notes .= ' (<b>unvalidated email</b>)';
|
|
}
|
|
}
|
|
|
|
# query if we haven't queried based on this email address before
|
|
if (!$emailcounts{$warned->{email}}) {
|
|
my $rows = $dbr->selectall_arrayref("SELECT mailid, userid, timesent, subject FROM abuse_mail " .
|
|
"WHERE type='abuse' AND mailto = ?", undef, $warned->{email});
|
|
$emailcounts{$warned->{email}} = 1;
|
|
|
|
foreach my $row (@{$rows || []}) {
|
|
my ($mailid, $userid, $timesent, $subject) = @$row;
|
|
my $u = LJ::load_userid($userid);
|
|
|
|
$emails{$timesent} = "<tr><td>$timesent</td><td>$warned->{email}</td><td>" .
|
|
LJ::ljuser($u) . "</td><td>" .
|
|
"<a href='/admin/sendmail/query.bml?mode=view&mailid=$mailid'>$subject</a></td></tr>\n";
|
|
}
|
|
}
|
|
|
|
# now construct output
|
|
$ret .= "<tr><td>$date</td><td>" . LJ::ljuser($admin) . "</td><td>" . LJ::ljuser($warned) . "</td>";
|
|
$ret .= "<td>$notes</td></tr>\n";
|
|
}
|
|
my $cols = join('', map { "<th style='text-align: left;'>$_</th>" } qw(Date Admin Warned Notes) );
|
|
$ret = "<table width='600'><tr>$cols</tr>$ret</table>" if $ret;
|
|
|
|
# now append emails
|
|
if (%emails) {
|
|
$ret .= "<table style='width: 600px; margin-top: 10px;'>";
|
|
$ret .= "<tr>" . join('', map { "<th style='text-align: left;'>$_</th>" } qw(Date Email Admin Subject) ) . "</tr>";
|
|
$ret .= join('', map { $emails{$_} } sort { $a cmp $b } keys %emails);
|
|
$ret .= "</table>";
|
|
}
|
|
|
|
# get message to put into body for sending
|
|
my $message = LJ::load_include('spam-warning');
|
|
$message =~ s/\[\[user\]\]/$poster->{user}/ig;
|
|
|
|
# now construct the parts of the email
|
|
$ret .= "<form method='post' action='/admin/sendmail/send.bml?action=preview'>";
|
|
$ret .= LJ::html_hidden(email => $poster->{email},
|
|
bcc => $remote->{email},
|
|
subject => "Your LJ Rossia.org Account",
|
|
request => '000000',
|
|
message => $message,
|
|
extra => "spam-notification;$poster->{userid}",
|
|
from => "abuse",);
|
|
$ret .= '<p align="center">' . LJ::html_submit('Send Warning Email') . '</p>';
|
|
|
|
# include unvalidated email warning
|
|
unless ($poster->{status} eq 'A') {
|
|
$ret .= "<p><span style='color: red;'>WARNING:</span> The account you are viewing (" .
|
|
LJ::ljuser($poster) . ") has an <b>unvalidated email address</b>.</p>";
|
|
}
|
|
|
|
# return
|
|
$ret = "<?standout $ret standout?></form><br />";
|
|
return $ret;
|
|
});
|
|
|
|
|
|
### Fetch the value for the given I<field> from the specified I<arghash>,
|
|
### untaint it with the given I<pattern>, and return the results. If the
|
|
### I<pattern> has match-groups in it, the values matched with them will be the
|
|
### returned values. Otherwise, the entire input will be returned.
|
|
sub untaint {
|
|
my ( $arghash, $field, $pattern ) = @_;
|
|
|
|
return '' unless exists $arghash->{$field} && defined $arghash->{$field};
|
|
my $input = $arghash->{$field};
|
|
$pattern = qr{$pattern}i unless ref $pattern eq 'Regexp';
|
|
|
|
my @matches = ( $input =~ $pattern ) or return '';
|
|
return @matches if $1;
|
|
return $input;
|
|
}
|
|
|
|
|
|
# hook to do transforms for posting pictures from FB
|
|
LJ::register_hook('transform_update_postpics', sub {
|
|
my ($GET, $POST) = @_;
|
|
|
|
my (
|
|
@ids,
|
|
$picsize,
|
|
$columns,
|
|
$caporient,
|
|
$border,
|
|
@pics,
|
|
@rows,
|
|
$row,
|
|
$nextrow,
|
|
$pic,
|
|
$imgtag,
|
|
$imgcell,
|
|
$capcell,
|
|
@html,
|
|
);
|
|
|
|
|
|
# Untaint and split the picture ids to post
|
|
@ids = split /:/, $1 if exists $POST->{ids} && $POST->{ids} =~ m{^([\d:]+)};
|
|
|
|
return unless $POST->{'wizard-picsize'} =~ m{^([tsf])$}i;
|
|
$picsize = $1;
|
|
$columns = $1 if exists $POST->{'wizard-columns'}
|
|
&& $POST->{'wizard-columns'} =~ m{^([1-4])$};
|
|
$caporient = $1 if exists $POST->{'wizard-caporient'}
|
|
&& $POST->{'wizard-caporient'} =~ m{^([arbl0])$};
|
|
$border = 1 if $POST->{'wizard-border'};
|
|
|
|
# Default/bound some values if not defined or valid -- Large picsize
|
|
if ( $picsize eq 'f' ) {
|
|
$columns = 1;
|
|
}
|
|
|
|
# Medium picsize
|
|
elsif ( $picsize eq 's' ) {
|
|
$columns = 1 if $columns < 1;
|
|
$columns = 2 if $columns > 2;
|
|
}
|
|
|
|
# Thumbnail picsize
|
|
else {
|
|
$columns = 1 if $columns < 1;
|
|
$columns = 4 if $columns > 4;
|
|
}
|
|
|
|
# Make sure the caption orientation will work with the number of columns
|
|
# defined.
|
|
if ( $columns == 1 || $columns == 3 ) {
|
|
$caporient = 'b' unless $caporient eq '0' || $caporient eq 'a';
|
|
}
|
|
|
|
# Build the array of ids to flow into the chosen layout
|
|
@pics = map {{
|
|
id => $_,
|
|
captitle => untaint( $POST, "subj$_", qr{([\t\r\n\x20-\xff]*)} ),
|
|
capdesc => untaint( $POST, "desc$_", qr{([\t\r\n\x20-\xff]*)} ),
|
|
img => untaint( $POST, "${picsize}img$_", $LJ::REGEX{httpuri} ),
|
|
imgwidth => untaint( $POST, "${picsize}w$_", qr{(\d+)} ),
|
|
imgheight => untaint( $POST, "${picsize}h$_", qr{(\d+)} ),
|
|
url => untaint( $POST, "url$_", $LJ::REGEX{httpuri} ),
|
|
}} @ids;
|
|
|
|
|
|
# Build a table for the pics and their captions
|
|
while ( @pics ) {
|
|
$row = [];
|
|
$nextrow = [];
|
|
|
|
# Fill up each row with the specified number of columns
|
|
while ( @$row < $columns ) {
|
|
$pic = shift @pics;
|
|
|
|
# If there's a picture to add, do so
|
|
if ( $pic ) {
|
|
$imgtag = sprintf q{<img src="%s" alt="%s" height="%d" width="%d" border="0" />},
|
|
@{$pic}{qw[img captitle imgheight imgwidth]};
|
|
$imgcell = sprintf q{<a href="%s">%s</a>},
|
|
$pic->{url}, $imgtag;
|
|
$capcell = sprintf qq{<strong>%s</strong><br />\n\t\t%s},
|
|
@{$pic}{qw[captitle capdesc]};
|
|
}
|
|
|
|
# Otherwise it'll be a blank cell
|
|
else {
|
|
$imgcell = '';
|
|
$capcell = '';
|
|
}
|
|
|
|
## Now arrange the caption relative to the pic if there is a caption
|
|
|
|
# Above
|
|
if ( $caporient eq 'a' ) {
|
|
push @$row, $capcell;
|
|
push @$nextrow, $imgcell;
|
|
}
|
|
|
|
# Below
|
|
elsif ( $caporient eq 'b' ) {
|
|
push @$row, $imgcell;
|
|
push @$nextrow, $capcell;
|
|
}
|
|
|
|
# Leftish captions, then the image, then rightish captions
|
|
else {
|
|
push @$row, $capcell if $caporient eq 'l';
|
|
push @$row, $imgcell;
|
|
push @$row, $capcell if $caporient eq 'r';
|
|
}
|
|
}
|
|
|
|
push @rows, $row;
|
|
push @rows, $nextrow if @$nextrow;
|
|
}
|
|
|
|
# Mangle the rows into an indented HTML table
|
|
@html = ();
|
|
|
|
push @html, (
|
|
" <!-- Posted pictures -->",
|
|
" <table>"
|
|
);
|
|
foreach my $row ( @rows ) {
|
|
push @html, (
|
|
" <tr>",
|
|
(map { " <td>$_</td>" } @$row),
|
|
" </tr>",
|
|
);
|
|
}
|
|
push @html, " </table>\n <!-- End of Posted pictures -->\n\n";
|
|
|
|
# Stick the results into the posted event
|
|
$POST->{event} = join "\n", @html;
|
|
return;
|
|
});
|
|
|
|
# hook to hit akamai to remove a userpic
|
|
LJ::register_hook('expunge_userpic', sub {
|
|
my ($picid, $userid) = @_;
|
|
$picid += 0;
|
|
$userid += 0;
|
|
return undef unless $picid && $userid;
|
|
|
|
# now hit akamai
|
|
my $res = SOAP::Lite
|
|
->service($LJ::AKAMAI{service})
|
|
->purgeRequest($LJ::AKAMAI{username}, $LJ::AKAMAI{password}, $LJ::AKAMAI{network},
|
|
[''], ["$LJ::USERPIC_ROOT/$picid/$userid"]);
|
|
|
|
# see if there was an error
|
|
my ($code, $msg) = ($res->{resultCode}, $res->{resultMsg});
|
|
if ($code == 300) {
|
|
return [ 'info', "Akamai cache purged successfully." ];
|
|
} else {
|
|
return [ 'error', "Error $code: $msg (CACHE NOT PURGED)" ];
|
|
}
|
|
});
|
|
|
|
# cluster definition hook
|
|
LJ::register_hook('cluster_description', sub {
|
|
my $clusterid = $_[0]+0;
|
|
my ($ob, $cb) = $_[1] ? ('<strong>', '</strong>') : ('', '');
|
|
|
|
my ($cid, $scid) = ($clusterid, undef);
|
|
($cid, $scid) = ($1, $2) if $clusterid =~ /^(\d)(\d+)$/;
|
|
|
|
my $text = $ob . ($LJ::CLUSTERNAME{$cid} || $cid) . $cb;
|
|
$text .= ", subcluster $ob$scid$cb" if defined $scid;
|
|
return $text;
|
|
});
|
|
|
|
# hook to override show_poll for GoatVote polls
|
|
LJ::register_hook('alternate_show_poll_html', sub {
|
|
my ($po, $mode, $qs) = @_;
|
|
|
|
# if mode is enter, we don't handle
|
|
return undef if $mode eq 'enter';
|
|
|
|
# if it's not a goatvote...
|
|
return undef unless LJ::LJcom::is_goatvote_poll($po, $qs);
|
|
|
|
# return a link to the goatvote page
|
|
LJ::Poll::clean_poll(\$po->{name}) if $po->{name};
|
|
my $ret = "<b><a href=\"$LJ::SITEROOT/poll/goatvote.bml?id=$po->{pollid}\">Poll \#$po->{pollid}:" .
|
|
"</a></b> <i>$po->{name}</i><br />Open to: <b>$po->{whovote}</b>, results viewable " .
|
|
"to: <b>$po->{whoview}</b><br />This is a GoatVote poll. Current results are " .
|
|
"<a href=\"$LJ::SITEROOT/poll/goatvote.bml?id=$po->{pollid}\">available elsewhere</a>. You " .
|
|
"can also <a href=\"$LJ::SITEROOT/poll/?id=$po->{pollid}&mode=enter\">fill out the poll</a>.";
|
|
return $ret;
|
|
});
|
|
|
|
# extra viewing line HTML
|
|
LJ::register_hook('extra_poll_description', sub {
|
|
my ($po, $qs) = @_;
|
|
|
|
# if it's a goatvote
|
|
return '' unless LJ::LJcom::is_goatvote_poll($po, $qs);
|
|
|
|
# okay return our string
|
|
return "You may view the <a href=\"$LJ::SITEROOT/poll/goatvote.bml?id=$po->{pollid}\">" .
|
|
'GoatVote results in progress</a>.';
|
|
});
|
|
|
|
# hook to show goatvote in poll pregenerator
|
|
LJ::register_hook('poll_pregeneration_html', sub {
|
|
my ($u, $is_authas) = @_;
|
|
return unless LJ::check_priv($u, 'siteadmin', 'goatvote');
|
|
|
|
# okay, show them the options
|
|
my $getextra = $is_authas ? "authas=$u->{'user'}&" : '';
|
|
my $body = "<?h1 Pregenerated Polls h1?><?p The following types of polls can automatically be " .
|
|
"generated to assist you in quickly and easily creating a poll. p?>";
|
|
$body .= "<ul><li><a href=\"create.bml?${getextra}pregen=1\">GoatVote</a></li></ul>";
|
|
$body .= "<?p Or, use the form below to begin creating your very own poll. p?>";
|
|
return $body;
|
|
});
|
|
|
|
# actually pregenerate a poll
|
|
LJ::register_hook('pregenerate_poll', sub {
|
|
my ($u, $pgid) = @_;
|
|
return undef unless $pgid && LJ::check_priv($u, 'siteadmin', 'goatvote'); # only one option for now
|
|
|
|
# throw a goatvoate together
|
|
if ($pgid == 1) {
|
|
return {
|
|
count => 3,
|
|
name => 'GoatVote: ',
|
|
whovote => 'all',
|
|
whoview => 'all',
|
|
pq => [
|
|
{
|
|
type => 'radio',
|
|
question => 'What point of view do you most agree with?',
|
|
opts => 5,
|
|
opt => [ '', '', '', '', '' ],
|
|
}, {
|
|
type => 'text',
|
|
question => 'What URL supports this point of view best?',
|
|
size => 30,
|
|
maxlength => 255,
|
|
}, {
|
|
type => 'text',
|
|
question => 'What other URL supports this point of view?',
|
|
size => 30,
|
|
maxlength => 255,
|
|
}
|
|
],
|
|
};
|
|
}
|
|
|
|
# caller expects a hashref
|
|
return {};
|
|
});
|
|
|
|
LJ::register_hook("get_cap_bit", sub {
|
|
my $name = shift;
|
|
return undef unless $name;
|
|
|
|
return $LJ::Pay::capinf{$name}->{'bit'};
|
|
});
|
|
|
|
# Register hooks for turning on/off certain cap bits
|
|
# This needs to be expanded to activate/deactivate bonus
|
|
# features, etc, but right now we just be sure to run
|
|
# LJ::activate_userpics()
|
|
#LJ::register_hook("modify_caps", sub {
|
|
# my $arg = shift;
|
|
#
|
|
# # 1-4 = free-perm, 9 = extra userpics
|
|
# foreach (1..4, 9) {
|
|
# next unless $arg->{'cap_on_mod'}->{$_} || $arg->{'cap_off_mod'}->{$_};
|
|
#
|
|
# # only run once, with newest caps...
|
|
# $arg->{'u'}->{'caps'} = $arg->{'newcaps'};
|
|
# return LJ::activate_userpics($arg->{'u'});
|
|
# }
|
|
#
|
|
# return 1;
|
|
#});
|
|
|
|
# check for a user diskquota cap. returning undef defers the check to normal means
|
|
#LJ::register_hook("check_cap_disk_quota", sub {
|
|
# my $u = shift;
|
|
# return undef unless $u;
|
|
#
|
|
# my $dbr = LJ::get_db_reader();
|
|
# my $size = $dbr->selectrow_array("SELECT size FROM paidexp WHERE userid=? AND item='diskquota'",
|
|
# undef, $u->{'userid'});
|
|
# return $size || undef;
|
|
#});
|
|
|
|
LJ::register_hook("ssl_check", sub {
|
|
my $r = $_[0]{r};
|
|
return
|
|
$r->header_in("X-LJ-SSL") ||
|
|
($LJ::IS_DEV_SERVER && $r->header_in("Host") eq "secure.$LJ::DOMAIN");
|
|
});
|
|
|
|
#LJ::register_hook("post_create", \&LJ::Pay::post_create);
|
|
|
|
#LJ::register_hook("create.bml_opts", sub {
|
|
# my $ar = shift;
|
|
# my $ret = $ar->{ret};
|
|
# my $get = $ar->{get};
|
|
# my $post = $ar->{post};
|
|
#
|
|
# $$ret .= "<li><div class='formitem'><div class='formitemName'>$BML::ML{'ljcom.accounttype'}</div>";
|
|
# $$ret .= "<div style='margin: 10px 0 10px 0px'>";
|
|
#
|
|
# my $valid_code = 0;
|
|
# my $code = $get->{code} || $post->{code};
|
|
# if ($code) {
|
|
# my $dbr = LJ::get_db_reader();
|
|
# my ($acid, $auth) = LJ::acct_code_decode($code);
|
|
#
|
|
# if (my $piid = $dbr->selectrow_array("SELECT piid FROM acctpayitem WHERE acid=?",
|
|
# undef, $acid))
|
|
# {
|
|
# my ($item, $qty) = $dbr->selectrow_array("SELECT item, qty FROM payitems ".
|
|
# "WHERE piid=?", undef, $piid);
|
|
#
|
|
# if ($item eq 'perm') {
|
|
# $$ret .= "Permanent Account";
|
|
# } else {
|
|
# $$ret .= "Paid for " . ($qty+0) . " Months";
|
|
# }
|
|
# $$ret .= ", from code: $code";
|
|
#
|
|
# $valid_code++;
|
|
# }
|
|
# }
|
|
|
|
# unless ($valid_code) {
|
|
# my @atypes = ([ 0, $BML::ML{'ljcom.account.free'} ],
|
|
# [ 2, $BML::ML{'ljcom.account.paid2'} ],
|
|
# [ 6, $BML::ML{'ljcom.account.paid6'} ],
|
|
# [ 12, $BML::ML{'ljcom.account.paid12'} ]);
|
|
#
|
|
# my $cur_type = $post->{'ljcom_atype'}+0;
|
|
# foreach my $at (@atypes) {
|
|
# $$ret .= LJ::html_check({ name => 'ljcom_atype', id => "ljcom_atype_$at->[0]",
|
|
# value => $at->[0],
|
|
# type => 'radio', selected => ($cur_type == $at->[0]) });
|
|
# $$ret .= " <label for='ljcom_atype_$at->[0]'>$at->[1]</label><br />\n";
|
|
# }
|
|
# }
|
|
#
|
|
# $$ret .= "</div>";
|
|
#
|
|
#
|
|
# # if they've already got a code for paid time, no reason to show the feature list
|
|
# return if $valid_code;
|
|
#
|
|
# $$ret .= '
|
|
#<table cellspacing="1" cellpadding="4" border="0" width="100%">
|
|
#<tr>
|
|
#<td class="tablehead" style="text-align: left;">'.$BML::ML{'ljcom.account.feature'}.'</td>
|
|
#<td class="tablehead">'.$BML::ML{'ljcom.account.free'}.'</td>
|
|
#
|
|
#<td class="tablehead">'.$BML::ML{'ljcom.account.paid'}.'</td>
|
|
#</tr>';
|
|
#
|
|
# my @features = (
|
|
# [ "$BML::ML{'ljcom.account.feature.ownblog'}", "Y", "Y" ],
|
|
# [ "$BML::ML{'ljcom.account.feature.styles'}", "$BML::ML{'ljcom.account.feature.limit'}", "Y" ],
|
|
# [ "$BML::ML{'ljcom.account.feature.syn'}", "Y", "Y" ],
|
|
# [ "$BML::ML{'ljcom.account.feature.pp'}", "N", "Y" ],
|
|
# [ "$BML::ML{'ljcom.account.feature.search'}", "N", "Y" ],
|
|
# [ "$BML::ML{'ljcom.account.feature.photo'}", "N", "Y" ],
|
|
#
|
|
# );
|
|
# my %map = ("N" => "-",
|
|
# "Y"=> "<img src='$LJ::IMGPREFIX/blue_check.gif' width='15' height='15' alt='Yes' />");
|
|
# foreach my $f (@features) {
|
|
# my ($name, $free, $paid) = @$f;
|
|
# $free = $map{$free} || $free;
|
|
# $paid = $map{$paid} || $paid;
|
|
# $$ret .= "<tr><td class='tablelabel'>$name</td>".
|
|
# "<td class='tablecontent'>$free</td>".
|
|
# "<td class='tablecontent'>$paid</td></tr>\n";
|
|
# }
|
|
# $$ret .= "<tr><td rowspan='3' class='tablebottom'>" .
|
|
# BML::ml('ljcom.account.feature.full2', { aopts => "target='_new' href='$LJ::SITEROOT/site/accounts.bml'" }) .
|
|
# "</td></tr></table>\n";
|
|
#
|
|
# $$ret .= "</div></li>";
|
|
#
|
|
# return;
|
|
#});
|
|
|
|
#LJ::register_hook("create.bml_postsession", sub {
|
|
# my $ar = shift;
|
|
# my $post = $ar->{post};
|
|
# my $redir = $ar->{redirect};
|
|
# my $u = $ar->{u};
|
|
#
|
|
# my $atype = int($post->{'ljcom_atype'});
|
|
# $atype = 0 unless $LJ::Pay::account{$atype};
|
|
# LJ::set_userprop($u, "create_accttype", $atype || "free");
|
|
# return unless $atype || $u->underage;
|
|
#
|
|
# my $cartobj = LJ::Pay::new_cart($u);
|
|
# my $rv = LJ::Pay::add_cart_item($cartobj, {
|
|
# item => 'paidacct',
|
|
# qty => $post->{ljcom_atype},
|
|
# amt => $LJ::Pay::account{$atype}->{amount},
|
|
# rcptid => $u->{userid},
|
|
# }) if $atype;
|
|
# my $rv2 = LJ::Pay::add_cart_item($cartobj, {
|
|
# item => 'coppa',
|
|
# rcptid => $u->{userid},
|
|
# }) if $u->underage;
|
|
# if ($cartobj && ($rv || !$atype) && ($rv2 || !$u->underage)) {
|
|
# my $c = $cartobj->{payid} . "-" . $cartobj->{anum};
|
|
# if ($u->underage) {
|
|
# my $extra = $u->underage_status eq 'O' ? '&o=1' : '';
|
|
# $$redir = "$LJ::SITEROOT/agecheck/?c=$c$extra";
|
|
# } else {
|
|
# $$redir = "$LJ::SITEROOT/pay/?c=$c";
|
|
# }
|
|
# }
|
|
#});
|
|
|
|
#LJ::register_hook("userinfo_rows", sub {
|
|
# my $args = shift;
|
|
# my $u = $args->{'u'};
|
|
# my $dbr = $args->{'dbr'};
|
|
# my $remote = $args->{'remote'};
|
|
# my @ret;
|
|
# return if $u->{journaltype} eq "I";
|
|
# $ret[0] = "<a href='/support/faqbrowse.bml?faqid=38' style='white-space: nowrap'>$BML::ML{'ljcom.userinfo.accounttype'}</a>";
|
|
#
|
|
# my $paid = $u->{'caps'} & 8;
|
|
# my $perm = $u->{'caps'} & 16;
|
|
# if ($remote && $paid && ! $perm &&
|
|
# ($remote->{'userid'} == $u->{'userid'} ||
|
|
# $u->{'journaltype'} ne 'P' &&
|
|
# LJ::check_rel($u->{'userid'}, $remote->{'userid'}, 'A')))
|
|
# {
|
|
# my $paiduntil = $dbr->selectrow_array("SELECT paiduntil FROM paiduser ".
|
|
# "WHERE userid=$u->{'userid'}");
|
|
# $ret[1] = LJ::LJcom::acct_name($u->{'caps'}, substr($paiduntil, 0, 10));
|
|
# } else {
|
|
# $ret[1] = LJ::LJcom::acct_name($u->{'caps'});
|
|
# }
|
|
# return @ret;
|
|
#});
|
|
|
|
#LJ::register_hook("update.bml_disable_can_post", sub {
|
|
# my $arg = shift;
|
|
# ${$arg->{title}} = "Trial account expired";
|
|
# ${$arg->{body}} = "Your 30 day LiveJournal trial account has expired. For more information on what you can do at this point, check out the <a href='/trial/'>LiveJournal Trial Page</a>.";
|
|
# return 1;
|
|
#});
|
|
|
|
|
|
#LJ::register_hook("login_add_opts", sub {
|
|
# my $args = shift;
|
|
# my $u = $args->{'u'};
|
|
# my $form = $args->{'form'};
|
|
# my $optref = $args->{'opts'};
|
|
#
|
|
# if (LJ::get_cap($u, "fastserver") && ! $form->{'notfast'}) {
|
|
# push @$optref, "FS"; # fast server
|
|
# }
|
|
#});
|
|
|
|
#LJ::register_hook("post_logout", sub {
|
|
# my $site_domain = $LJ::SITEROOT;
|
|
# $site_domain =~ s!^\w+://!!;
|
|
# $site_domain =~ s!(:\d+)?/.*!!;
|
|
#
|
|
# # feb-24-2003: fastserver cookie is now unused, but we'll delete it for awhile
|
|
# foreach (qw(ljfastserver betatest)) {
|
|
# BML::set_cookie($_, "", undef, $LJ::COOKIE_PATH, $LJ::COOKIE_DOMAIN);
|
|
# }
|
|
#});
|
|
|
|
#LJ::register_hook("userinfo_html_by_user", sub {
|
|
# my $o = shift;
|
|
# my $r = $o->{'ret'};
|
|
# my $u = $o->{'u'};
|
|
# return unless (LJ::get_cap($u, "paid"));
|
|
# $$r .= "<a href='/paidaccounts/'><img src='$LJ::IMGPREFIX/talk/md10_thumbup.gif' width='25' height='19' alt='$BML::ML{'ljcom.userinfo.paiduser'}' style='vertical-align: middle; border: 0;' /></a>";
|
|
#});
|
|
|
|
LJ::register_hook("userinfo_local_props", sub {
|
|
my $o = shift;
|
|
push @{$o->{props}}, 'no_mail_alias';
|
|
});
|
|
|
|
LJ::register_hook("canonicalize_url", sub {
|
|
my $u = shift;
|
|
# $$u =~ s!^http://lj\.rossia\.org!http://lj.rossia.org!;
|
|
if ($$u =~ m!^http://lj\.rossia\.org!) {
|
|
$$u =~ s!&nc=\d+!!;
|
|
}
|
|
foreach my $pattern (qw(
|
|
\.(jpg|jpeg|gif|png)$
|
|
selectsmart\.com
|
|
/test
|
|
/quiz
|
|
quiz\.html
|
|
test\.html
|
|
elitechild\.com
|
|
lj\.rossia\.org/user
|
|
))
|
|
{
|
|
next unless $$u =~ /$pattern/i;
|
|
$$u = "";
|
|
return;
|
|
}
|
|
|
|
# strip anchor names (to prevent some online tests from showing up
|
|
# a billion times)
|
|
$$u =~ s/\#.+//;
|
|
});
|
|
|
|
#LJ::register_hook("expand_embedded", sub {
|
|
# LJ::PhonePost::show_phoneposts(@_);
|
|
#});
|
|
|
|
#LJ::register_hook("url_phonepost", sub {
|
|
# my ($u, $dppid, $ext) = @_;
|
|
# my $host = $LJ::FILES_DOMAIN || "lj.rossia.org";
|
|
# return "http://$host/$u->{'user'}/phonepost/$dppid.$ext";
|
|
#});
|
|
|
|
#LJ::register_hook("data_handler:phonepost", sub {
|
|
# my ($user, $pathextra) = @_;
|
|
# if ($pathextra =~ m#^/(\d+)\.(mp3|ogg|wav)$#) {
|
|
# my $dppid = $1;
|
|
# return sub {
|
|
# my $r = shift;
|
|
# my $u = LJ::load_user($user);
|
|
# return LJ::PhonePost::apache_content($r, $u, $dppid);
|
|
# };
|
|
# }
|
|
# return undef;
|
|
#});
|
|
|
|
#LJ::register_hook("files_handler:phonepost", sub {
|
|
# my ($user, $pathextra) = @_;
|
|
# if ($pathextra =~ m#^/(\d+)\.(mp3|ogg|wav)$#) {
|
|
# my $dppid = $1;
|
|
# return sub {
|
|
# my $r = shift;
|
|
# my $u = LJ::load_user($user);
|
|
# return LJ::PhonePost::apache_content($r, $u, $dppid);
|
|
# };
|
|
# }
|
|
# return undef;
|
|
#});
|
|
|
|
#LJ::register_hook("modify_login_menu", sub {
|
|
# my $a = shift;
|
|
# my $u = $a->{'u'};
|
|
# my $user = $a->{'user'};
|
|
# my $menu = $a->{'menu'};
|
|
#
|
|
# unless ($u->{'caps'} & (8|4)) { # unless perm or paid
|
|
# LJ::load_user_props($u, 'browselang');
|
|
# my $text = LJ::Lang::get_text($u->{'browselang'}, 'ljcom.menu.upgrade');
|
|
# push @$menu, { 'text' => $text,
|
|
# 'url' => "$LJ::SITEROOT/paidaccounts/", };
|
|
# }
|
|
#});
|
|
|
|
#LJ::register_hook("validate_get_remote", sub {
|
|
# my $a = shift;
|
|
# my $caps = $a->{'caps'};
|
|
## my $criterr = $a->{'criterr'};
|
|
# my $sopts = $a->{'sopts'};
|
|
#
|
|
# if ($sopts =~ /\.FS\b/ && ! LJ::get_cap($caps, 'fastserver')) {
|
|
# $$criterr = 1; # forged fastserver session option!
|
|
# return 0;
|
|
# }
|
|
#
|
|
# return 1;
|
|
#});
|
|
|
|
#LJ::register_hook("emailconfirmed", sub {
|
|
# &LJ::nodb;
|
|
# my ($u) = @_;
|
|
# return unless LJ::get_cap($u, "useremail");
|
|
# return if exists $LJ::FIXED_ALIAS{$u->{'user'}};
|
|
#
|
|
# LJ::load_user_props($u, { 'use_master' => 1 }, "no_mail_alias");
|
|
# return if $u->{'no_mail_alias'};
|
|
#
|
|
# my $dbh = LJ::get_db_writer();
|
|
# $dbh->do("REPLACE INTO email_aliases (alias, rcpt) VALUES (?,?)",
|
|
# undef, "$u->{'user'}\@$LJ::USER_DOMAIN", $u->{'email'});
|
|
#});
|
|
|
|
#LJ::register_hook("bad_password", sub {
|
|
# return undef if $LJ::NO_PASSWORD_CHECK;
|
|
#
|
|
# my $arg = shift;
|
|
# my $u = ref $arg eq 'HASH' ? $arg : undef;
|
|
#
|
|
# # only scalar password passed
|
|
# unless ($u) {
|
|
# return undef unless $LJ::OPTMOD_CRACKLIB;
|
|
# my $reason = Crypt::Cracklib::fascist_check($arg);
|
|
# return $reason eq 'ok' ? undef : $reason;
|
|
# }
|
|
#
|
|
# # u hashref passed
|
|
# my $reason = $LJ::OPTMOD_CRACKLIB ?
|
|
# Crypt::Cracklib::fascist_check($u->{'password'}) : "ok";
|
|
# return $reason unless $reason eq 'ok';
|
|
#
|
|
# # we have a $u passed, we can do smart checking
|
|
# my $user = lc($u->{'user'});
|
|
# my $pass = lc($u->{'password'});
|
|
# my $email = lc($u->{'email'});
|
|
# my $name = lc($u->{'name'});
|
|
# my $ml_code = undef;
|
|
#
|
|
# # username matches
|
|
# if ($user && (index($pass, $user) >= 0 || index($user, $pass) >= 0)) {
|
|
# $ml_code = 'ljcom.badpass.username';
|
|
# }
|
|
#
|
|
# # email matches
|
|
# elsif ($email && (index($pass, $email) >= 0 || index($email, $pass) >= 0)) {
|
|
# $ml_code = 'ljcom.badpass.email';
|
|
# }
|
|
#
|
|
# # real name matches
|
|
# elsif ($name && (index($pass, $name) >= 0 || index ($name, $pass) >= 0)) {
|
|
# $ml_code = 'ljcom.badpass.realname';
|
|
# }
|
|
#
|
|
# if ($ml_code) {
|
|
# LJ::load_user_props($u, 'browselang');
|
|
# return LJ::Lang::get_text($u->{'lang'}, $ml_code);
|
|
# }
|
|
#
|
|
# # no match
|
|
# return undef;
|
|
#
|
|
#});
|
|
|
|
# meetup links
|
|
#LJ::register_hook("interests_bml", sub {
|
|
# my $arg = shift;
|
|
# my $db = LJ::get_db_reader();
|
|
# my $r = $db->selectrow_hashref("SELECT urlkey, name FROM meetup_ints WHERE intid=?", undef,
|
|
# $arg->{'intid'});
|
|
# return unless $r;
|
|
# my $ret = $arg->{'ret'};
|
|
# my $name = LJ::ehtml($r->{'name'});
|
|
# my $urlargs;
|
|
# my $remote = $arg->{'remote'};
|
|
# if ($remote) {
|
|
# LJ::load_user_props($db, $remote, "zip");
|
|
# if ($remote->{'zip'}) {
|
|
# $urlargs .= "?zip=$remote->{'zip'}";
|
|
# }
|
|
# }
|
|
# my $moreinfo;
|
|
# if ($LJ::HELPURL{'meetup'}) {
|
|
# $moreinfo = BML::ml('ljcom.meetup.moreinfo', {'link' => $LJ::HELPURL{'meetup'}});
|
|
# }
|
|
# my $link = "<a href=\"http://$r->{'urlkey'}.meetup.com/$urlargs\">";
|
|
# $link .= BML::ml('ljcom.meetup.link', { 'name' => $name}) . "</a>";
|
|
# $$ret .= "<?h1 $BML::ML{'ljcom.meetup.head'} h1?>";
|
|
# $$ret .= "<?p " . BML::ml('ljcom.meetup.text', { 'link' => $link }) . " $moreinfo p?>";
|
|
#});
|
|
|
|
#sub LJ::is_utf8 {
|
|
# return isLegalUTF8String($_[0], length($_[0]));
|
|
#}
|
|
|
|
LJ::register_hook("s1_style_select", sub {
|
|
my $arg = shift;
|
|
my $styleid = $arg->{'styleid'};
|
|
my $u = $arg->{'u'};
|
|
if ($arg->{'view'} eq "lastn" && $u->{'journaltype'} eq "Y" && $LJ::SYN_LASTN_S1) {
|
|
$$styleid = $LJ::SYN_LASTN_S1;
|
|
}
|
|
if ($arg->{'view'} eq "calendar" && $u->{'journaltype'} eq "Y" && $LJ::SYN_CALENDAR_S1) {
|
|
$$styleid = $LJ::SYN_CALENDAR_S1;
|
|
}
|
|
if ($arg->{'view'} eq "day" && $u->{'journaltype'} eq "Y" && $LJ::SYN_DAY_S1) {
|
|
$$styleid = $LJ::SYN_DAY_S1;
|
|
}
|
|
});
|
|
|
|
LJ::register_hook("force_s1", sub {
|
|
my $u = shift;
|
|
my $forceflag = shift;
|
|
|
|
# Force syndicated accounts to S1
|
|
if ( $u->{journaltype} eq 'Y' ) {
|
|
$$forceflag = 1;
|
|
}
|
|
});
|
|
|
|
LJ::register_hook("finduser_extrainfo", sub {
|
|
my $arg = shift;
|
|
my $u = $arg->{'u'};
|
|
my $dbh = $arg->{'dbh'};
|
|
my $ret;
|
|
if ($u->{'caps'} & 16) {
|
|
$ret .= " Permanent account.\n";
|
|
}
|
|
if ($u->{'caps'} & 8) {
|
|
my $unt = $dbh->selectrow_array("SELECT paiduntil FROM paiduser WHERE userid=?", undef,
|
|
$u->{'userid'});
|
|
$ret .= " Paid until: $unt\n";
|
|
}
|
|
});
|
|
|
|
LJ::register_hook("support_see_request_html", sub {
|
|
my $arg = shift;
|
|
my $sp = $arg->{'sp'};
|
|
my $cat = $sp->{_cat}->{'catkey'};
|
|
my $ret = $arg->{'retref'};
|
|
my $email = $arg->{'email'};
|
|
my $u = $arg->{'u'};
|
|
my $remote = $arg->{'remote'};
|
|
|
|
my $manage = LJ::remote_has_priv($remote, "moneysearch") || LJ::remote_has_priv($remote, "moneyview");
|
|
|
|
if ($cat eq "accounts" && $manage) {
|
|
$$ret .= "<p align='center'><b>";
|
|
$$ret .= "[<a href='/admin/accounts/paidsearch.bml?method=email&value=" . LJ::eurl($email) . "'>paidsearch: email</a>] ";
|
|
if ($sp->{'requserid'}) {
|
|
$$ret .= "[<a href='/admin/accounts/paidsearch.bml?method=user&value=$u->{'user'}'>paidsearch: user</a>] ";
|
|
}
|
|
$$ret .= "</b></p>";
|
|
}
|
|
|
|
});
|
|
|
|
#LJ::register_hook("recent_action_flags", sub {
|
|
# # these flags live in their own site-local namespace
|
|
# # and must be prepended with '_' to avoid collisions
|
|
#
|
|
# return { phonepost => '_F', # 'F'onepost, meh
|
|
# phonepost_mp3 => '_M' }->{$_[0]}; # 'M'p3
|
|
#});
|
|
|
|
LJ::register_hook("postpost", sub {
|
|
my $arg = shift;
|
|
my $uo = $arg->{'journal'};
|
|
return if $uo->{'journaltype'} eq "Y"; # no syndicated
|
|
my $up = $arg->{'poster'};
|
|
|
|
# if the poster has opted out, don't record the post
|
|
# LJ::load_user_props($up, "latest_optout");
|
|
# return if $up->{latest_optout};
|
|
#
|
|
# setup security
|
|
my $security = $arg->{'security'};
|
|
$security = $arg->{'allowmask'} == 1 ? 'friends' : 'custom'
|
|
if ($security eq 'usemask');
|
|
|
|
# see if it has a public image in it. heuristic: it's an http://
|
|
# URL in an image tag, or it's alone and has a popular image extension
|
|
my $img;
|
|
if ($security eq "public" &&
|
|
($arg->{'event'} =~ m!<img.+src=([\'\"])(http://[^\'\"]+?)\1!i ||
|
|
$arg->{'event'} =~ m!<img.+src=(http://\S+?)[\s\>\'\"]!i ||
|
|
$arg->{'event'} =~ m!(http://\S+\.(?:gif|jpe?g|png)\b)!i)) {
|
|
$img = $2 || $1;
|
|
|
|
# make sure image is good and hasn't been used in last 4 hours
|
|
unless (length($img) < 100 && $img !~ /[\n\r]/ &&
|
|
LJ::MemCache::add("ljcom_imgused:$img", 1, 3600*4)) {
|
|
undef $img;
|
|
}
|
|
}
|
|
|
|
LJ::cmd_buffer_add($uo->{clusterid}, $uo->{'userid'}, "ljcom_newpost", {
|
|
'timepost' => time(),
|
|
'journalid' => $uo->{'userid'},
|
|
'posterid' => $up->{'userid'},
|
|
'itemid' => $arg->{'itemid'},
|
|
'anum' => $arg->{'anum'},
|
|
'security' => $security,
|
|
'img' => $img,
|
|
'taglist' => $arg->{'props'}->{'taglist'},
|
|
});
|
|
});
|
|
|
|
# TEMP: Log unknown8bit posts to decide if they can be disabled later
|
|
# see also table definition in update-db-local.pl
|
|
LJ::register_hook("postpost", sub {
|
|
my $entry = shift;
|
|
return unless $LJ::DEBUG{'survey_8bit'} && $entry->{'props'}->{'unknown8bit'};
|
|
my $dbh = LJ::get_db_writer();
|
|
$dbh->do("REPLACE INTO survey_v0_8bit (userid, timepost) VALUES (?, UNIX_TIMESTAMP())",
|
|
undef, $entry->{'poster'}->{'userid'});
|
|
});
|
|
|
|
LJ::register_hook("cmdbuf:ljcom_newpost:start", sub {
|
|
my ($dbh) = @_;
|
|
$LJ::CACHE_RECENTPOSTS_CHANGES = 0;
|
|
$LJ::CACHE_RECENTPOSTS ||= LJ::MemCache::get("blob:ljcom_latestposts2") || [];
|
|
|
|
$LJ::CACHE_RECENTIMG_CHANGES = 0;
|
|
$LJ::CACHE_RECENTIMG ||= LJ::MemCache::get("blob:ljcom_latestimg") || [];
|
|
});
|
|
|
|
LJ::register_hook("cmdbuf:ljcom_newpost:too_old", sub { 60*60*2 });
|
|
|
|
LJ::register_hook("cmdbuf:ljcom_newpost:run", sub {
|
|
my ($dbh, $db, $c) = @_;
|
|
my $args = $c->{'args'};
|
|
|
|
my $recent = $LJ::CACHE_RECENTPOSTS;
|
|
my $uj = LJ::load_userid($args->{'journalid'});
|
|
my $up = LJ::load_userid($args->{'posterid'});
|
|
return unless $uj->{'statusvis'} eq "V" && $up->{'statusvis'} eq "V";
|
|
|
|
LJ::load_user_props($uj, "journaltitle");
|
|
|
|
my $rp = {};
|
|
$rp->{$_} = $args->{$_}+0 foreach qw(timepost itemid anum);
|
|
$rp->{security} = $args->{security};
|
|
$rp->{clusterid} = $up->{clusterid}+0;
|
|
$rp->{tags} = [ split(/\s*,\s*/, $args->{taglist}) ];
|
|
$rp->{journalu} = {
|
|
user => $uj->{user},
|
|
userid => $uj->{userid}+0,
|
|
journaltype => $uj->{journaltype},
|
|
},
|
|
$rp->{journalp} = {
|
|
user => $up->{user},
|
|
userid => $up->{userid}+0,
|
|
name => $up->{name},
|
|
};
|
|
|
|
push @$recent, $rp;
|
|
$LJ::CACHE_RECENTPOSTS_CHANGES++;
|
|
|
|
if ($args->{'img'}) {
|
|
my $rimg = $LJ::CACHE_RECENTIMG;
|
|
push @$rimg, [ $args->{'img'}, $rp->{journalu}, $args->{'itemid'}, $args->{'anum'} ];
|
|
$LJ::CACHE_RECENTIMG_CHANGES++;
|
|
}
|
|
});
|
|
|
|
LJ::register_hook("cmdbuf:ljcom_newpost:finish", sub {
|
|
my ($dbh) = @_;
|
|
return unless $LJ::CACHE_RECENTPOSTS_CHANGES;
|
|
my $recent = $LJ::CACHE_RECENTPOSTS;
|
|
my $rimg = $LJ::CACHE_RECENTIMG;
|
|
|
|
my $show_max = $LJ::STATS_LATESTPOSTS_MAX || 100;
|
|
|
|
@$recent = sort { $b->{'timepost'} <=> $a->{'timepost'} } @$recent;
|
|
splice(@$recent, $show_max) if @$recent > $show_max;
|
|
|
|
LJ::MemCache::set("blob:ljcom_latestposts2", $recent);
|
|
|
|
if ($LJ::CACHE_RECENTIMG_CHANGES) {
|
|
my $size = @$rimg;
|
|
splice(@$rimg, 0, $size - $show_max) if $size > $show_max;
|
|
LJ::MemCache::set("blob:ljcom_latestimg", $rimg);
|
|
}
|
|
LJ::MemCache::set("blob:ljcom_latestposts_stats",
|
|
[ scalar(@$recent),
|
|
$recent->[0]->{timepost},
|
|
$recent->[-1]->{timepost} ]);
|
|
});
|
|
|
|
# returns 1 if too fast, 0 if okay
|
|
LJ::register_hook("ccpay_rate_check", sub {
|
|
my ($tries, $lasttry) = @_;
|
|
|
|
# TRIES : LIMIT
|
|
# - 1.. 3: 0 sec
|
|
# - 4.. 6: 5 sec
|
|
# - 7..10: 15 sec
|
|
# - 11..19: 60 sec
|
|
# - 20....: 30 min
|
|
|
|
my $now = time();
|
|
return 0 if $tries <= 3;
|
|
return 0 if $tries <= 6 && $lasttry < $now - 5;
|
|
return 0 if $tries <= 10 && $lasttry < $now - 15;
|
|
return 0 if $tries <= 19 && $lasttry < $now - 60;
|
|
return 0 if $lasttry < $now - 1800;
|
|
return 1;
|
|
});
|
|
|
|
LJ::register_hook("cmdbuf:pay_fb_xmlrpc:run", sub {
|
|
my ($dbh, $db, $c) = @_;
|
|
|
|
return undef unless $LJ::FB_SITEROOT && $LJ::FB_QUOTA_NOTIFY;
|
|
|
|
my $args = $c->{args};
|
|
my $userid = $c->{journalid};
|
|
|
|
# args: item, size, exp
|
|
|
|
my $u = LJ::load_userid($userid);
|
|
return undef unless $u;
|
|
|
|
eval "use XMLRPC::Lite (); 1;"
|
|
or return undef;
|
|
|
|
return XMLRPC::Lite
|
|
->new( proxy => "$LJ::FB_SITEROOT/interface/xmlrpc",
|
|
timeout => 5 )
|
|
->call('FB.XMLRPC.set_quota', # xml-rpc method call
|
|
{ user => $u->{user},
|
|
item => $args->{item},
|
|
size => $args->{size},
|
|
exptime => $args->{exptime},
|
|
});
|
|
});
|
|
|
|
# given an S2 context, give back a BML langid.
|
|
#LJ::register_hook("set_s2bml_lang", sub {
|
|
# my ($ctx, $langref) = @_;
|
|
#
|
|
# my $lang = S2::get_property_value($ctx, 'lang_current');
|
|
#
|
|
# $lang = 'en' unless grep(/$lang/, @LJ::LANGS);
|
|
# $lang = 'en_LJ' if ($lang eq 'en');
|
|
#
|
|
# $$langref = $lang;
|
|
#});
|
|
|
|
# what tables bin/moveucluster.pl should move that aren't general code
|
|
#LJ::register_hook("moveucluster_local_tables", sub {
|
|
# return {
|
|
# 'phonepostentry' => 'userid',
|
|
# 'phoneposttrans' => 'journalid',
|
|
# };
|
|
#});
|
|
|
|
# remove transcription group userprop
|
|
#LJ::register_hook("delete_friend_group", sub {
|
|
# my ($u, $bit) = @_;
|
|
# LJ::load_user_props($u, 'pp_transallow');
|
|
# LJ::set_userprop($u, 'pp_transallow', -1) if $bit == $u->{pp_transallow};
|
|
#});
|
|
|
|
LJ::register_hook("userinfo_join_community", sub {
|
|
my $o = shift;
|
|
my $r = $o->{'ret'};
|
|
my $u = $o->{'u'};
|
|
$$r .= BML::ml('/userinfo.bml.membership.paidmembers') if $u->{'user'} eq "paidmembers";
|
|
return;
|
|
});
|
|
|
|
LJ::register_hook("forbid_request", sub {
|
|
my $r = shift;
|
|
my $ua = $r->header_in("User-Agent");
|
|
my $ip = $r->connection->remote_ip;
|
|
# @BAN_UA can be either scalar substrings of user-agents, or
|
|
# an arrayref of [ $substr, $ip ] which makes the substring
|
|
# match conditional on it matching that IP
|
|
foreach (@LJ::BAN_UA) {
|
|
if (ref) {
|
|
return 1 if $_->[1] eq $ip && index($ua, $_->[0]) != -1;
|
|
} else {
|
|
return 1 if index($ua, $_) != -1;
|
|
}
|
|
}
|
|
return 0;
|
|
});
|
|
|
|
LJ::register_hook("bot_director", sub {
|
|
my ($pre, $post) = @_;
|
|
return "$pre If you are running a bot please visit this policy page outlining rules you must respect. $LJ::SITEROOT/bots/ $post"
|
|
});
|
|
|
|
# control panel nag box
|
|
#LJ::register_hook('control_panel_extra_info', sub {
|
|
# my ($u, $ret) = @_;
|
|
#
|
|
# $$ret .= "<div id='ExtraInfo'>";
|
|
# if (LJ::get_cap($u, "paid")) {
|
|
# $$ret .= "For a complete summary of the LiveJournal.com services to which you are currently subscribed, visit the ";
|
|
# $$ret .= "<a href='/paidaccounts/status.bml?authas=$u->{user}'><strong>Paid Account Status</strong></a> page.";
|
|
# # render account summary
|
|
# $$ret .= LJ::Pay::account_summary($u);
|
|
# } else {
|
|
# $$ret .= "Nearly all of LiveJournal's functionality is available free of charge. However, if you're happy ";
|
|
# $$ret .= "with the service you're being provided, we encourage you to show your support and get a ";
|
|
# $$ret .= "<a href='/paidaccounts/'><strong>paid account</strong></a>.";
|
|
# }
|
|
# $$ret .= "</div>";
|
|
#});
|
|
|
|
# control panel extra column
|
|
#LJ::register_hook('control_panel_column', sub {
|
|
# my ($u, $ret) = @_;
|
|
# my $authas = ref $u ? "?authas=$u->{user}" : "";
|
|
#
|
|
# $$ret .= BML::fill_template('block', {
|
|
# 'HEADER' => "Paid Account Information",
|
|
# 'ABOUT' => "Additional information and options for paid accounts.",
|
|
# 'LIST' => "<li><a href='/paidaccounts/status.bml$authas' title='Review expiration dates for all paid services'>Paid Account Status</a></li>".
|
|
# "<li><a href='./files.bml$authas' title='Manage your available disk space'>File Manager</a></li>".
|
|
# "<li><a href='./phonepost.bml' title='<?_ml .information.phonepost.about _ml?>'><?_ml .information.phonepost _ml?></a></li>"
|
|
# });
|
|
#});
|
|
|
|
LJ::register_hook('entryforminfo', sub {
|
|
my $ret .= "<table style='width: 26em; margin-left: auto; margin-right: auto'><tr valign='top'><td style='text-align: center; border-right: 1px dashed #adadad; width: 50%;'>";
|
|
|
|
# $ret .= "<strong><a href='/paidaccounts/'>Paid account</a> options:</strong>";
|
|
# $ret .= "<ul style='text-align: left'>";#<li><a href='/phonepost/'>Post by Phone</a></li>";
|
|
# $ret .= "<li><a href='/manage/'>Post by E-mail</a></li>";
|
|
$ret .= "<li><a href='/poll/create.bml'>Create a Poll</a></li></ul>";
|
|
|
|
$ret .= "</td><td style='text-align: center'>";
|
|
|
|
# $ret .= "<strong>Download a client:</strong><ul style='text-align: left'>";
|
|
# $ret .= "<li><a href='/download/index.bml?platform=X+Window+System'>Linux</a> (Unix)</li>";
|
|
# $ret .= "<li><a href='/download/index.bml?platform=Macintosh'>Macintosh</a></li>";
|
|
# $ret .= "<li><a href='/download/index.bml?platform=Windows'>Windows</a></li>";
|
|
# $ret .= "<li><a href='/download/index.bml'>Others</a>…</li></ul>";
|
|
|
|
$ret .= "</td></tr></table>\n";
|
|
return $ret;
|
|
});
|
|
|
|
# args: { userid , ppid }
|
|
# appends enclosure or "" to rss $ret string
|
|
#LJ::register_hook('pp_rss_enclosure', sub {
|
|
# my $opts = shift;
|
|
# return LJ::PhonePost::make_link( undef, $opts->{userid},
|
|
# ( $opts->{ppid} >> 8 ), 'rss' );
|
|
#});
|
|
|
|
# args: name
|
|
# return: formatted name for local config
|
|
LJ::register_hook('identity_display_name', sub {
|
|
my $name = shift;
|
|
$name =~ s/\[(live|dead)journal\.com\]/\[${1}journal\]/;
|
|
$name =~ s/^(.+)\.(live|dead)journal\.com$/${1} \[${2}journal\]/;
|
|
|
|
return $name;
|
|
});
|
|
|
|
__DATA__
|
|
__C__
|
|
|
|
/*
|
|
* Copyright 2001 Unicode, Inc.
|
|
*
|
|
* Disclaimer
|
|
*
|
|
* This source code is provided as is by Unicode, Inc. No claims are
|
|
* made as to fitness for any particular purpose. No warranties of any
|
|
* kind are expressed or implied. The recipient agrees to determine
|
|
* applicability of information provided. If this file has been
|
|
* purchased on magnetic or optical media from Unicode, Inc., the
|
|
* sole remedy for any claim will be exchange of defective media
|
|
* within 90 days of receipt.
|
|
*
|
|
* Limitations on Rights to Redistribute This Code
|
|
*
|
|
* Unicode, Inc. hereby grants the right to freely use the information
|
|
* supplied in this file in the creation of products supporting the
|
|
* Unicode Standard, and to make copies of this file in any form
|
|
* for internal or external distribution as long as this notice
|
|
* remains attached.
|
|
*/
|
|
|
|
|
|
typedef unsigned char UTF8;
|
|
typedef unsigned char Boolean;
|
|
|
|
#define false 0
|
|
#define true 1
|
|
|
|
static const char trailingBytesForUTF8[256] = {
|
|
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
|
|
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
|
|
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
|
|
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
|
|
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
|
|
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
|
|
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
|
|
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5
|
|
};
|
|
|
|
static Boolean isLegalUTF8(UTF8 *source, int length) {
|
|
UTF8 a;
|
|
UTF8 *srcptr = source+length;
|
|
switch (length) {
|
|
default: return false;
|
|
/* Everything else falls through when "true"... */
|
|
case 4: if ((a = (*--srcptr)) < 0x80 || a > 0xBF) return false;
|
|
case 3: if ((a = (*--srcptr)) < 0x80 || a > 0xBF) return false;
|
|
case 2: if ((a = (*--srcptr)) > 0xBF) return false;
|
|
switch (*source) {
|
|
/* no fall-through in this inner switch */
|
|
case 0xE0: if (a < 0xA0) return false; break;
|
|
case 0xF0: if (a < 0x90) return false; break;
|
|
case 0xF4: if (a > 0x8F) return false; break;
|
|
default: if (a < 0x80) return false;
|
|
}
|
|
case 1: if (*source >= 0x80 && *source < 0xC2) return false;
|
|
if (*source > 0xF4) return false;
|
|
}
|
|
return true;
|
|
}
|
|
|
|
/********************* End code from Unicode, Inc. ***************/
|
|
|
|
/*
|
|
* Author: Brad Fitzpatrick
|
|
*
|
|
*/
|
|
|
|
Boolean isLegalUTF8String(char *str, int len)
|
|
{
|
|
UTF8 *cp = str;
|
|
int i;
|
|
while (*cp) {
|
|
/* how many bytes follow this character? */
|
|
int length = trailingBytesForUTF8[*cp]+1;
|
|
|
|
/* check for early termination of string: */
|
|
for (i=1; i<length; i++) {
|
|
if (cp[i] == 0) return false;
|
|
}
|
|
|
|
/* is this a valid group of characters? */
|
|
if (!isLegalUTF8(cp, length))
|
|
return false;
|
|
|
|
cp += length;
|
|
}
|
|
|
|
/* if we didn't make it to the end, there must've been an internal null
|
|
* in the perl string, which we're saying is bogus utf-8, since there's
|
|
* no point for users giving us null chars. */
|
|
return (cp == str+len) ? true : false;
|
|
}
|