zlax/ljr
zlax
/
ljr
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
ljr/ljcom/cgi-bin/ljcom.pl

1605 lines
54 KiB
Perl
Raw Normal View History

init
2019-02-05 21:49:12 +00:00
#!/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\@livejournal.com";
%LJ::FIXED_ALIAS = (
'lj' => 'lj', # discarded
'lj_notify' => 'lj', # also discarded
'test' => 'brad@danga.com',
'postmaster' => 'lisa@grrl.org',
'webmaster' => 'lj',
'support' => 'lj',
'abuse' => 'lj',
'privacy' => 'lj',
'feedback' => 'lj',
'press' => 'lj',
'bradfitz' => 'brad@danga.com',
'paypal' => 'brad@danga.com',
'accounts' => 'lj',
'frank' => 'brad@danga.com',
'lj_coreadmins' => 'brad@danga.com, lisa@grrl.org, nbarkas@moduli.net',
'cvs-commits' => 'brad@danga.com, whitaker@danga.com, jproulx@livejournal.com, '.
'mellon@pobox.com, martine@danga.com, mahlon@danga.com, ged@danga.com',
'moodthemes' => 'evan@livejournal.com', # aliases to aliases!
'bot-watchers' => 'brad@danga.com',
);
@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 LiveJournal 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://livejournal\.com!http://www.livejournal.com!;
if ($$u =~ m!^http://www\.livejournal\.com!) {
$$u =~ s!&nc=\d+!!;
}
foreach my $pattern (qw(
\.(jpg|jpeg|gif|png)$
selectsmart\.com
/test
/quiz
quiz\.html
test\.html
elitechild\.com
livejournal\.com/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 || "files.livejournal.com";
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" && $u->{'password'} eq "" &&
$LJ::SYN_LASTN_S1) {
$$styleid = $LJ::SYN_LASTN_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&amp;value=" . LJ::eurl($email) . "'>paidsearch: email</a>] ";
if ($sp->{'requserid'}) {
$$ret .= "[<a href='/admin/accounts/paidsearch.bml?method=user&amp;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 || 1000;
@$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>&hellip;</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;
});
LJ::register_hook('offsite_journal_search', sub {
my $u = shift;
my $ret;
my $user = LJ::ehtml($u->{'user'});
$ret .= qq{
<?h1 LJSeek Search h1?>
<?p
<b>Note:</b> This search is provided by an independent company, <a href='http://www.ljseek.com/'>LJSeek</a>, and is provided solely as a convenience. We are not responsible for the resulting content or search results.
p?>
<?standout
<form action="http://www.ljseek.com/search.php" method="get"><br>
<input type="hidden" name="users" value="$user" />
<table cellspacing="0" cellpadding="0" border="0">
<tr>
<td valign="center"><p class="search"><b>Search Term:&nbsp;</b></td>
<td valign="center"><input type="text" name="q" size="25">&nbsp;</td>
<td valign="center"><select name="sortby">
<option value="4" selected>sort by time & relevance</option>
<option value="1">sort by relevance</option>
<option value="2">sort by time, desc</option>
<option value="3">sort by time, asc</option>
</select>&nbsp;</td>
<td valign="center"><input type="submit" value="Find!"></td>
</tr>
<tr>
<td valign="top" align="right" colspan="2"><table border="0" cellspacing="0" cellpadding="0"><tr>
<td><input type="checkbox" name="strict"></td>
<td valign="top" nobr class="text"><b>exact phrase</b></td>
</tr></table></td>
<td colspan="2">&nbsp;</td>
</tr></table></form>
standout?>
};
return $ret;
});
__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;
}