994 lines
30 KiB
Perl
994 lines
30 KiB
Perl
# This code was forked from the LiveJournal project owned and operated
|
|
# by Live Journal, Inc. The code has been modified and expanded by
|
|
# Dreamwidth Studios, LLC. These files were originally licensed under
|
|
# the terms of the license supplied by Live Journal, Inc, which can
|
|
# currently be found at:
|
|
#
|
|
# http://code.livejournal.org/trac/livejournal/browser/trunk/LICENSE-LiveJournal.txt
|
|
#
|
|
# In accordance with the original license, this code and all its
|
|
# modifications are provided under the GNU General Public License.
|
|
# A copy of that license can be found in the LICENSE file included as
|
|
# part of this distribution.
|
|
|
|
package LJ;
|
|
|
|
use strict;
|
|
no warnings 'uninitialized';
|
|
|
|
BEGIN {
|
|
# ugly hack to shutup dependent libraries which sometimes want to bring in
|
|
# ljlib.pl (via require, ick!). so this lets them know if it's recursive.
|
|
# we REALLY need to move the rest of this crap to .pm files.
|
|
|
|
# ensure we have $LJ::HOME, or complain very vigorously
|
|
$LJ::HOME ||= $ENV{LJHOME};
|
|
die "No \$LJ::HOME set, or not a directory!\n"
|
|
unless $LJ::HOME && -d $LJ::HOME;
|
|
|
|
# Allow setting dev server mode from environment. This is needed because
|
|
# Plack startup doesn't go through Apache config where $IS_DEV_SERVER is
|
|
# normally set. WARNING: Must NEVER be set in production — it enables
|
|
# ?as= user impersonation, auto-verified accounts, and skips domain logic.
|
|
$LJ::IS_DEV_SERVER = 1 if $ENV{LJ_IS_DEV_SERVER};
|
|
|
|
use lib ( $LJ::HOME || $ENV{LJHOME} ) . "/extlib/lib/perl5";
|
|
|
|
# Please do not change this to "LJ::Directories"
|
|
require $LJ::HOME . "/cgi-bin/LJ/Directories.pm";
|
|
}
|
|
|
|
# now that the library is setup, we can start pulling things in. start with
|
|
# the configuration library we need.
|
|
use LJ::Config;
|
|
|
|
BEGIN {
|
|
# mod_perl does this early too, make sure we do as well
|
|
LJ::Config->load;
|
|
|
|
$LJ::LOGMEMCFMT = 'NNNQN';
|
|
$LJ::PUBLICBIT = 2**63;
|
|
}
|
|
|
|
# Now set up logging support for everybody else to access; this is done
|
|
# very early. We may be called by a test though, which will set the flag,
|
|
# and in that case we disable all the logging.
|
|
use Log::Log4perl;
|
|
|
|
BEGIN {
|
|
if ($LJ::_T_CONFIG) {
|
|
|
|
# Tests, don't log
|
|
my $conf = q{
|
|
log4perl.rootLogger=FATAL, DevNull
|
|
|
|
log4perl.appender.DevNull=Log::Log4perl::Appender::File
|
|
log4perl.appender.DevNull.filename=/dev/null
|
|
log4perl.appender.DevNull.layout=Log::Log4perl::Layout::SimpleLayout
|
|
};
|
|
Log::Log4perl::init( \$conf );
|
|
}
|
|
else {
|
|
Log::Log4perl::init_and_watch( LJ::resolve_file('etc/log4perl.conf'), 10 );
|
|
}
|
|
}
|
|
|
|
use Carp;
|
|
use DBI;
|
|
use DBI::Role;
|
|
use HTTP::Date ();
|
|
use LJ::Utils qw(rand_chars);
|
|
use LJ::Hooks;
|
|
use LJ::MemCache;
|
|
use LJ::Error;
|
|
use LJ::Auth; # has a bunch of pkg LJ functions at bottom
|
|
use LJ::User; # has a bunch of pkg LJ, non-OO methods at bottom
|
|
use LJ::Entry; # has a bunch of pkg LJ, non-OO methods at bottom
|
|
use LJ::Global::Constants; # formerly LJ::Constants
|
|
use Time::Local ();
|
|
use Storable ();
|
|
use Compress::Zlib ();
|
|
use DW::Request;
|
|
use TheSchwartz;
|
|
use TheSchwartz::Job;
|
|
use LJ::Comment;
|
|
use LJ::Message;
|
|
use LJ::ConvUTF8;
|
|
use LJ::Userpic;
|
|
use LJ::ModuleCheck;
|
|
use IO::Socket::INET;
|
|
use IO::Socket::SSL;
|
|
use Mozilla::CA;
|
|
|
|
use LJ::UniqCookie;
|
|
use LJ::WorkerResultStorage;
|
|
use DW::External::Account;
|
|
use DW::External::User;
|
|
use DW::Logic::LogItems;
|
|
use LJ::CleanHTML;
|
|
use DW::LatestFeed;
|
|
use LJ::Keywords;
|
|
use LJ::DB;
|
|
use LJ::Tags;
|
|
use LJ::TextUtil;
|
|
use LJ::Time;
|
|
use LJ::Capabilities;
|
|
use DW::Mood;
|
|
use LJ::Global::Img; # defines LJ::Img
|
|
use LJ::Global::Secrets; # defines LJ::Secrets
|
|
use DW::Media;
|
|
use DW::Stats;
|
|
use DW::Proxy;
|
|
use DW::TaskQueue;
|
|
use DW::BlobStore;
|
|
|
|
# Load more modules so that we get as much advantage out of prefork
|
|
# memory allocation as possible (as well as moving as much loading cost
|
|
# to startup time)
|
|
BEGIN {
|
|
# Do not run if we're in a test
|
|
unless ($LJ::_T_CONFIG) {
|
|
LJ::ModuleCheck->have_xmlatom;
|
|
LJ::Hooks::_load_hooks_dir();
|
|
Storable::thaw( Storable::freeze( {} ) );
|
|
foreach my $minifile ( "GIF89a", "\x89PNG\x0d\x0a\x1a\x0a", "\xFF\xD8" ) {
|
|
Image::Size::imgsize( \$minifile );
|
|
}
|
|
LJ::CleanHTML::helper_preload();
|
|
|
|
# load drivers depending on what we have available
|
|
eval "use DBD::mysql;";
|
|
unless ($@) {
|
|
DBI->install_driver("mysql");
|
|
}
|
|
}
|
|
}
|
|
|
|
$Net::HTTPS::SSL_SOCKET_CLASS = "IO::Socket::SSL";
|
|
|
|
# make Unicode::MapUTF8 autoload:
|
|
sub Unicode::MapUTF8::AUTOLOAD {
|
|
die "Unknown subroutine $Unicode::MapUTF8::AUTOLOAD"
|
|
unless $Unicode::MapUTF8::AUTOLOAD =~ /::(utf8_supported_charset|to_utf8|from_utf8)$/;
|
|
LJ::ConvUTF8->load;
|
|
no strict 'refs';
|
|
goto *{$Unicode::MapUTF8::AUTOLOAD}{CODE};
|
|
}
|
|
|
|
sub END { LJ::end_request(); }
|
|
|
|
require "$LJ::HOME/cgi-bin/ljlib-local.pl"
|
|
if -e "$LJ::HOME/cgi-bin/ljlib-local.pl";
|
|
|
|
# if this is a dev server, alias LJ::D to Data::Dumper::Dumper
|
|
if ($LJ::IS_DEV_SERVER) {
|
|
eval "use Data::Dumper ();";
|
|
*LJ::D = \&Data::Dumper::Dumper;
|
|
}
|
|
|
|
LJ::MemCache::init();
|
|
|
|
# $LJ::PROTOCOL_VER is the version of the client-server protocol
|
|
# used uniformly by server code which uses the protocol. We used
|
|
# to set this to "0" if $LJ::UNICODE was false, but now we assume
|
|
# we always want to use Unicode.
|
|
$LJ::PROTOCOL_VER = "1";
|
|
|
|
# declare views for user journals
|
|
%LJ::viewinfo = (
|
|
"lastn" => {
|
|
"des" => "Most Recent Events",
|
|
},
|
|
"archive" => {
|
|
"des" => "Archive",
|
|
},
|
|
"day" => {
|
|
"des" => "Day View",
|
|
},
|
|
"read" => {
|
|
"des" => "Reading Page",
|
|
"owner_props" => [ "opt_usesharedpic", "friendspagetitle", "friendspagesubtitle" ],
|
|
},
|
|
"network" => {
|
|
"des" => "Network View",
|
|
"styleof" => "read",
|
|
},
|
|
"data" => {
|
|
"des" => "Data View (RSS, etc.)",
|
|
"owner_props" => [ "opt_whatemailshow", "no_mail_alias" ],
|
|
},
|
|
"rss" => { # this is now provided by the "data" view.
|
|
"des" => "RSS View (XML)",
|
|
},
|
|
"res" => {
|
|
"des" => "S2-specific resources (stylesheet)",
|
|
},
|
|
"info" => {
|
|
|
|
# just a redirect to profile.bml for now.
|
|
# in S2, will be a real view.
|
|
"des" => "Profile Page",
|
|
},
|
|
"profile" => {
|
|
|
|
# just a redirect to profile.bml for now.
|
|
# in S2, will be a real view.
|
|
"des" => "Profile Page",
|
|
},
|
|
"tag" => {
|
|
"des" => "Filtered Recent Entries View",
|
|
},
|
|
"security" => {
|
|
"des" => "Filtered Recent Entries View",
|
|
},
|
|
"update" => {
|
|
|
|
# just a redirect to update.bml for now.
|
|
# real solution is some sort of better nav
|
|
# within journal styles.
|
|
"des" => "Update Journal",
|
|
},
|
|
"icons" => {
|
|
"des" => "Icons",
|
|
},
|
|
);
|
|
|
|
## we want to set this right away, so when we get a HUP signal later
|
|
## and our signal handler sets it to true, perl doesn't need to malloc,
|
|
## since malloc may not be thread-safe and we could core dump.
|
|
## see LJ::clear_caches and LJ::handle_caches
|
|
$LJ::CLEAR_CACHES = 0;
|
|
|
|
my $GTop;
|
|
my %SecretCache;
|
|
|
|
## if this library is used in a BML page, we don't want to destroy BML's
|
|
## HUP signal handler.
|
|
if ( $SIG{'HUP'} ) {
|
|
my $oldsig = $SIG{'HUP'};
|
|
$SIG{'HUP'} = sub {
|
|
&{$oldsig} if ref $oldsig eq "CODE";
|
|
LJ::clear_caches();
|
|
};
|
|
}
|
|
else {
|
|
$SIG{'HUP'} = \&LJ::clear_caches;
|
|
}
|
|
|
|
# Initialize our statistics reporting library if needed
|
|
if ( $LJ::STATS{host} && $LJ::STATS{port} ) {
|
|
DW::Stats::setup( $LJ::STATS{host}, $LJ::STATS{port} );
|
|
}
|
|
|
|
sub locker {
|
|
return $LJ::LOCKER_OBJ if $LJ::LOCKER_OBJ;
|
|
eval "use DDLockClient ();";
|
|
die "Couldn't load locker client: $@" if $@;
|
|
|
|
$LJ::LOCKER_OBJ = new DDLockClient(
|
|
servers => [@LJ::LOCK_SERVERS],
|
|
lockdir => $LJ::LOCKDIR || "$LJ::HOME/locks",
|
|
);
|
|
|
|
return $LJ::LOCKER_OBJ;
|
|
}
|
|
|
|
sub gearman_client {
|
|
my $purpose = shift;
|
|
|
|
return undef unless @LJ::GEARMAN_SERVERS;
|
|
eval "use Gearman::Client; 1;" or die "No Gearman::Client available: $@";
|
|
|
|
my $client = Gearman::Client->new;
|
|
$client->job_servers(@LJ::GEARMAN_SERVERS);
|
|
|
|
return $client;
|
|
}
|
|
|
|
sub theschwartz {
|
|
return LJ::Test->theschwartz(@_) if $LJ::_T_FAKESCHWARTZ;
|
|
|
|
my $opts = shift;
|
|
|
|
my $role = $opts->{role} || "default";
|
|
|
|
return $LJ::SchwartzClient{$role} if $LJ::SchwartzClient{$role};
|
|
|
|
unless ( scalar grep { defined $_->{role} } @LJ::THESCHWARTZ_DBS ) { # old config
|
|
$LJ::SchwartzClient{$role} = TheSchwartz->new( databases => \@LJ::THESCHWARTZ_DBS );
|
|
return $LJ::SchwartzClient{$role};
|
|
}
|
|
|
|
my @dbs = grep { $_->{role}->{$role} } @LJ::THESCHWARTZ_DBS;
|
|
die "Unknown role in LJ::theschwartz: '$role'" unless @dbs;
|
|
|
|
$LJ::SchwartzClient{$role} = TheSchwartz->new( databases => \@dbs );
|
|
|
|
return $LJ::SchwartzClient{$role};
|
|
}
|
|
|
|
sub gtop {
|
|
unless ($LJ::GTOP_LOADED) {
|
|
eval "use GTop;";
|
|
die "Couldn't load GTop: $@" if $@;
|
|
$LJ::GTOP_LOADED = 1;
|
|
}
|
|
return $GTop ||= GTop->new;
|
|
}
|
|
|
|
# Loads and caches one or more of the various *proplist (and ratelist)
|
|
# tables, which describe the various meta-data that can be stored on log
|
|
# (journal) items, comments, users, media, etc.
|
|
#
|
|
# Please use LJ::get_prop to actually retrieve properties. You probably
|
|
# don't want to call this function directly.
|
|
sub load_props {
|
|
my %keyname = (
|
|
log => [ 'propid', 'logproplist' ],
|
|
media => [ 'propid', 'media_prop_list' ],
|
|
rate => [ 'rlid', 'ratelist' ],
|
|
talk => [ 'tpropid', 'talkproplist' ],
|
|
user => [ 'upropid', 'userproplist' ],
|
|
);
|
|
|
|
my $dbr = LJ::get_db_reader()
|
|
or croak 'Failed to get database reader handle';
|
|
|
|
foreach my $t (@_) {
|
|
confess 'Attempted to load invalid property list'
|
|
unless exists $keyname{$t};
|
|
next if defined $LJ::CACHE_PROP{$t};
|
|
|
|
my ( $key, $table ) = @{ $keyname{$t} };
|
|
my $res = $dbr->selectall_hashref( "SELECT * FROM $table", $key );
|
|
croak $dbr->errstr if $dbr->err;
|
|
croak 'Failed to load properties from list'
|
|
unless $res && ref $res eq 'HASH';
|
|
|
|
foreach my $id ( keys %$res ) {
|
|
my $p = $res->{$id};
|
|
|
|
$p->{id} = $id;
|
|
$LJ::CACHE_PROP{$t}->{ $p->{name} } = $p;
|
|
$LJ::CACHE_PROPID{$t}->{ $p->{id} } = $p;
|
|
}
|
|
}
|
|
}
|
|
|
|
# <LJFUNC>
|
|
# name: LJ::get_prop
|
|
# des: This is used to retrieve
|
|
# a hashref of a row from the given tablename's proplist table.
|
|
# One difference from getting it straight from the database is
|
|
# that the 'id' key is always present, as a copy of the real
|
|
# proplist unique id for that table.
|
|
# args: table, name
|
|
# returns: hashref of proplist row from db
|
|
# des-table: the tables to get a proplist hashref from. Can be one of
|
|
# "log", "talk", or "user".
|
|
# des-name: the name of the prop to get the hashref of.
|
|
# </LJFUNC>
|
|
sub get_prop {
|
|
my $table = shift;
|
|
my $name = shift;
|
|
unless ( defined $LJ::CACHE_PROP{$table} && $LJ::CACHE_PROP{$table}->{$name} ) {
|
|
$LJ::CACHE_PROP{$table} = undef;
|
|
LJ::load_props($table);
|
|
}
|
|
|
|
unless ( $LJ::CACHE_PROP{$table} ) {
|
|
warn "Prop table has no data: $table" if $LJ::IS_DEV_SERVER;
|
|
return undef;
|
|
}
|
|
|
|
unless ( $LJ::CACHE_PROP{$table}->{$name} ) {
|
|
warn "Prop does not exist: $table - $name" if $LJ::IS_DEV_SERVER;
|
|
return undef;
|
|
}
|
|
|
|
return $LJ::CACHE_PROP{$table}->{$name};
|
|
}
|
|
|
|
# <LJFUNC>
|
|
# name: LJ::load_codes
|
|
# des: Populates hashrefs with lookup data from the database or from memory,
|
|
# if already loaded in the past. Examples of such lookup data include
|
|
# state codes, color name/value mappings, etc.
|
|
# args: dbarg?, whatwhere
|
|
# des-whatwhere: a hashref with keys being the code types you want to load
|
|
# and their associated values being hashrefs to where you
|
|
# want that data to be populated.
|
|
# </LJFUNC>
|
|
sub load_codes {
|
|
my $req = shift;
|
|
|
|
my $dbr = LJ::get_db_reader()
|
|
or die "Unable to get database handle";
|
|
|
|
foreach my $type ( keys %{$req} ) {
|
|
my $memkey = "load_codes:$type";
|
|
unless ( $LJ::CACHE_CODES{$type} ||= LJ::MemCache::get($memkey) ) {
|
|
$LJ::CACHE_CODES{$type} = [];
|
|
my $sth = $dbr->prepare("SELECT code, item, sortorder FROM codes WHERE type=?");
|
|
$sth->execute($type);
|
|
while ( my ( $code, $item, $sortorder ) = $sth->fetchrow_array ) {
|
|
push @{ $LJ::CACHE_CODES{$type} }, [ $code, $item, $sortorder ];
|
|
}
|
|
@{ $LJ::CACHE_CODES{$type} } =
|
|
sort { $a->[2] <=> $b->[2] } @{ $LJ::CACHE_CODES{$type} };
|
|
LJ::MemCache::set( $memkey, $LJ::CACHE_CODES{$type}, 60 * 15 );
|
|
}
|
|
|
|
foreach my $it ( @{ $LJ::CACHE_CODES{$type} } ) {
|
|
if ( ref $req->{$type} eq "HASH" ) {
|
|
$req->{$type}->{ $it->[0] } = $it->[1];
|
|
}
|
|
elsif ( ref $req->{$type} eq "ARRAY" ) {
|
|
push @{ $req->{$type} }, { 'code' => $it->[0], 'item' => $it->[1] };
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# <LJFUNC>
|
|
# name: LJ::clear_caches
|
|
# des: This function is called from a HUP signal handler and is intentionally
|
|
# very very simple (1 line) so we don't core dump on a system without
|
|
# reentrant libraries. It just sets a flag to clear the caches at the
|
|
# beginning of the next request (see [func[LJ::handle_caches]]).
|
|
# There should be no need to ever call this function directly.
|
|
# </LJFUNC>
|
|
sub clear_caches {
|
|
$LJ::CLEAR_CACHES = 1;
|
|
}
|
|
|
|
# <LJFUNC>
|
|
# name: LJ::handle_caches
|
|
# des: clears caches if the CLEAR_CACHES flag is set from an earlier
|
|
# HUP signal that called [func[LJ::clear_caches]], otherwise
|
|
# does nothing.
|
|
# returns: true (always) so you can use it in a conjunction of
|
|
# statements in a while loop around the application like:
|
|
# while (LJ::handle_caches() && FCGI::accept())
|
|
# </LJFUNC>
|
|
sub handle_caches {
|
|
return 1 unless $LJ::CLEAR_CACHES;
|
|
$LJ::CLEAR_CACHES = 0;
|
|
|
|
LJ::Config->load;
|
|
|
|
$LJ::DBIRole->flush_cache();
|
|
|
|
%LJ::CACHE_PROP = ();
|
|
%LJ::CACHE_STYLE = ();
|
|
$LJ::CACHED_MOODS = 0;
|
|
$LJ::CACHED_MOOD_MAX = 0;
|
|
%LJ::CACHE_MOODS = ();
|
|
%LJ::CACHE_MOOD_THEME = ();
|
|
%LJ::CACHE_USERID = ();
|
|
%LJ::CACHE_USERNAME = ();
|
|
%LJ::CACHE_CODES = ();
|
|
%LJ::CACHE_USERPROP = (); # {$prop}->{ 'upropid' => ... , 'indexed' => 0|1 };
|
|
%LJ::CACHE_ENCODINGS = ();
|
|
|
|
return 1;
|
|
}
|
|
|
|
# <LJFUNC>
|
|
# name: LJ::start_request
|
|
# des: Before a new web request is obtained, this should be called to
|
|
# determine if process should die or keep working, clean caches,
|
|
# reload config files, etc.
|
|
# returns: 1 if a new request is to be processed, 0 if process should die.
|
|
# </LJFUNC>
|
|
sub start_request {
|
|
handle_caches();
|
|
|
|
# TODO: check process growth size
|
|
|
|
# clear per-request caches
|
|
LJ::unset_remote(); # clear cached remote
|
|
$LJ::ACTIVE_JOURNAL = undef; # for LJ::{get,set}_active_journal
|
|
%LJ::CACHE_USERPIC = (); # picid -> hashref
|
|
%LJ::CACHE_USERPIC_INFO = (); # uid -> { ... }
|
|
%LJ::CACHE_S2THEME = ();
|
|
%LJ::REQ_CACHE_USER_NAME = (); # users by name
|
|
%LJ::REQ_CACHE_USER_ID = (); # users by id
|
|
%LJ::REQ_CACHE_REL = (); # relations from LJ::check_rel()
|
|
%LJ::REQ_LANGDATFILE = (); # caches language files
|
|
%LJ::S2::REQ_CACHE_STYLE_ID = (); # styleid -> hashref of s2 layers for style
|
|
%LJ::S2::REQ_CACHE_LAYER_ID =
|
|
(); # layerid -> hashref of s2 layer info (from LJ::S2::load_layer)
|
|
%LJ::S2::REQ_CACHE_LAYER_INFO =
|
|
(); # layerid -> hashref of s2 layer info (from LJ::S2::load_layer_info)
|
|
%LJ::REQ_HEAD_HAS = (); # avoid code duplication for js
|
|
%LJ::NEEDED_RES = (); # needed resources (css/js/etc):
|
|
@LJ::NEEDED_RES = (); # needed resources, in order requested (implicit dependencies)
|
|
# keys are relative from htdocs, values 1 or 2 (1=external, 2=inline)
|
|
|
|
%LJ::REQ_GLOBAL = (); # per-request globals
|
|
%LJ::_ML_USED_STRINGS = (); # strings looked up in this web request
|
|
%LJ::REQ_CACHE_USERTAGS =
|
|
(); # uid -> { ... }; populated by get_usertags, so we don't load it twice
|
|
$LJ::ACTIVE_RES_GROUP = undef; # use whatever is current site default
|
|
|
|
%LJ::PAID_STATUS = (); # per-request paid status
|
|
|
|
%LJ::REQUEST_CACHE = (); # request cached items ( longterm goal, store everything in here )
|
|
|
|
$LJ::CACHE_REMOTE_BOUNCE_URL = undef;
|
|
LJ::Userpic->reset_singletons;
|
|
LJ::Comment->reset_singletons;
|
|
LJ::Entry->reset_singletons;
|
|
LJ::Message->reset_singletons;
|
|
|
|
LJ::UniqCookie->clear_request_cache;
|
|
|
|
# clear the handle request cache (like normal cache, but verified already for
|
|
# this request to be ->ping'able).
|
|
$LJ::DBIRole->clear_req_cache();
|
|
|
|
# need to suck db weights down on every request (we check
|
|
# the serial number of last db weight change on every request
|
|
# to validate master db connection, instead of selecting
|
|
# the connection ID... just as fast, but with a point!)
|
|
$LJ::DBIRole->trigger_weight_reload();
|
|
|
|
# reset BML's cookies
|
|
eval { BML::reset_cookies() };
|
|
|
|
# reload config if necessary
|
|
LJ::Config->start_request_reload;
|
|
|
|
# reset the request abstraction layer
|
|
DW::Request->reset;
|
|
|
|
# include standard files if this is web-context
|
|
LJ::register_standard_resources();
|
|
|
|
LJ::Hooks::run_hooks("start_request");
|
|
|
|
return 1;
|
|
}
|
|
|
|
# Register standard site-wide CSS/JS resources. Called from start_request
|
|
# (for Apache, where DW::Request is already available) and from the Plack
|
|
# middleware (where the request must be created before this can run).
|
|
sub register_standard_resources {
|
|
my $r = DW::Request->get or return;
|
|
|
|
# sorry everybody, this is a gross hack ... we need to not use jquery on the shop since
|
|
# jquery is pretty old and crufty and PCI compliance etc, so we're just not going to include
|
|
# it here if we're on that domain
|
|
my $NO_JQUERY = 0;
|
|
if ( $LJ::DOMAIN_SHOP
|
|
&& $LJ::DOMAIN_SHOP ne $LJ::DOMAIN_WEB
|
|
&& $r->host eq $LJ::DOMAIN_SHOP )
|
|
{
|
|
$NO_JQUERY = 1;
|
|
}
|
|
|
|
# start with jquery core unless we've disabled it
|
|
LJ::need_res( { group => 'foundation', priority => $LJ::LIB_RES_PRIORITY },
|
|
'js/jquery/jquery-1.8.3.js' )
|
|
unless $NO_JQUERY;
|
|
|
|
# note that we're calling need_res and advising that these items
|
|
# are the new style global items
|
|
LJ::need_res(
|
|
{ group => 'foundation', priority => $LJ::LIB_RES_PRIORITY },
|
|
'js/foundation/vendor/custom.modernizr.js',
|
|
'js/foundation/foundation/foundation.js',
|
|
'js/foundation/foundation/foundation.topbar.js',
|
|
'js/dw/dw-core.js'
|
|
);
|
|
|
|
LJ::need_res(
|
|
{ group => 'jquery', priority => $LJ::LIB_RES_PRIORITY },
|
|
|
|
# jquery library is the big one, load first
|
|
'js/jquery/jquery-1.8.3.js',
|
|
|
|
# the rest of the libraries
|
|
qw(
|
|
js/dw/dw-core.js
|
|
),
|
|
);
|
|
|
|
# old/standard libraries are below here.
|
|
|
|
# standard site-wide JS and CSS
|
|
LJ::need_res(
|
|
{ priority => $LJ::LIB_RES_PRIORITY }, qw(
|
|
js/6alib/core.js
|
|
js/6alib/dom.js
|
|
js/6alib/httpreq.js
|
|
js/livejournal.js
|
|
)
|
|
);
|
|
|
|
LJ::need_res(
|
|
{ priority => $LJ::LIB_RES_PRIORITY, group => "all" }, qw (
|
|
stc/lj_base.css
|
|
)
|
|
);
|
|
|
|
# esn ajax
|
|
LJ::need_res(
|
|
{ priority => $LJ::LIB_RES_PRIORITY }, qw(
|
|
js/esn.js
|
|
stc/esn.css
|
|
)
|
|
) if LJ::is_enabled('esn_ajax');
|
|
|
|
# contextual popup JS
|
|
LJ::need_res(
|
|
{ priority => $LJ::LIB_RES_PRIORITY, group => "default" }, qw(
|
|
js/6alib/ippu.js
|
|
js/lj_ippu.js
|
|
js/6alib/hourglass.js
|
|
js/contextualhover.js
|
|
stc/contextualhover.css
|
|
)
|
|
);
|
|
|
|
my @ctx_popup_libraries = qw(
|
|
js/jquery/jquery.ui.core.js
|
|
js/jquery/jquery.ui.widget.js
|
|
|
|
js/jquery/jquery.ui.tooltip.js
|
|
js/jquery.ajaxtip.js
|
|
js/jquery/jquery.ui.position.js
|
|
stc/jquery/jquery.ui.core.css
|
|
stc/jquery/jquery.ui.tooltip.css
|
|
|
|
js/jquery.hoverIntent.js
|
|
js/jquery.contextualhover.js
|
|
stc/jquery.contextualhover.css
|
|
);
|
|
|
|
LJ::need_res( { priority => $LJ::LIB_RES_PRIORITY, group => 'jquery' }, @ctx_popup_libraries );
|
|
|
|
# foundation only gets this sometimes
|
|
LJ::need_res( { priority => $LJ::LIB_RES_PRIORITY, group => 'foundation' },
|
|
@ctx_popup_libraries )
|
|
unless $NO_JQUERY;
|
|
|
|
# development JS
|
|
LJ::need_res(
|
|
{ priority => $LJ::LIB_RES_PRIORITY }, qw(
|
|
js/6alib/devel.js
|
|
)
|
|
) if $LJ::IS_DEV_SERVER;
|
|
}
|
|
|
|
# <LJFUNC>
|
|
# name: LJ::end_request
|
|
# des: Clears cached DB handles (if [ljconfig[disconnect_dbs]] is
|
|
# true), and disconnects memcached handles (if [ljconfig[disconnect_memcache]] is
|
|
# true).
|
|
# </LJFUNC>
|
|
sub end_request {
|
|
LJ::flush_cleanup_handlers();
|
|
LJ::DB::disconnect_dbs() if $LJ::DISCONNECT_DBS;
|
|
LJ::MemCache::disconnect_all() if $LJ::DISCONNECT_MEMCACHE;
|
|
return 1;
|
|
}
|
|
|
|
# <LJFUNC>
|
|
# name: LJ::flush_cleanup_handlers
|
|
# des: Runs all cleanup handlers registered in @LJ::CLEANUP_HANDLERS
|
|
# </LJFUNC>
|
|
sub flush_cleanup_handlers {
|
|
while ( my $ref = shift @LJ::CLEANUP_HANDLERS ) {
|
|
next unless ref $ref eq 'CODE';
|
|
$ref->();
|
|
}
|
|
}
|
|
|
|
# <LJFUNC>
|
|
# name: LJ::color_fromdb
|
|
# des: Takes a value of unknown type from the DB and returns an #rrggbb string.
|
|
# args: color
|
|
# des-color: either a 24-bit decimal number, or an #rrggbb string.
|
|
# returns: scalar; #rrggbb string, or undef if unknown input format
|
|
# </LJFUNC>
|
|
sub color_fromdb {
|
|
my $c = shift;
|
|
return $c if $c =~ /^\#[0-9a-f]{6,6}$/i;
|
|
return sprintf( "\#%06x", $c ) if $c =~ /^\d+$/;
|
|
return undef;
|
|
}
|
|
|
|
# <LJFUNC>
|
|
# name: LJ::color_todb
|
|
# des: Takes an #rrggbb value and returns a 24-bit decimal number.
|
|
# args: color
|
|
# des-color: scalar; an #rrggbb string.
|
|
# returns: undef if bogus color, else scalar; 24-bit decimal number, can be up to 8 chars wide as a string.
|
|
# </LJFUNC>
|
|
sub color_todb {
|
|
my $c = shift;
|
|
return undef unless $c =~ /^\#[0-9a-f]{6,6}$/i;
|
|
return hex( substr( $c, 1, 6 ) );
|
|
}
|
|
|
|
# We're not always running under mod_perl... sometimes scripts (syndication sucker)
|
|
# call paths which end up thinking they need the remote IP, but don't.
|
|
sub get_remote_ip {
|
|
return $LJ::_T_FAKE_IP if $LJ::IS_DEV_SERVER && $LJ::_T_FAKE_IP;
|
|
|
|
my $r = DW::Request->get;
|
|
return ( $r ? $r->get_remote_ip : undef ) || $ENV{'FAKE_IP'};
|
|
}
|
|
|
|
# ($time, $secret) = LJ::get_secret(); # will generate
|
|
# $secret = LJ::get_secret($time); # won't generate
|
|
# ($time, $secret) = LJ::get_secret($time); # will generate (in wantarray)
|
|
sub get_secret {
|
|
my $time = int( $_[0] );
|
|
return undef if $_[0] && !$time;
|
|
my $want_new = !$time || wantarray;
|
|
|
|
if ( !$time ) {
|
|
$time = time();
|
|
$time -= $time % 3600; # one hour granularity
|
|
}
|
|
|
|
my $memkey = "secret:$time";
|
|
my $secret = ( $SecretCache{$memkey} ||= LJ::MemCache::get($memkey) );
|
|
return $want_new ? ( $time, $secret ) : $secret if $secret;
|
|
|
|
my $dbh = LJ::get_db_writer();
|
|
return undef unless $dbh;
|
|
$secret = $dbh->selectrow_array( q{SELECT secret FROM secrets WHERE stime = ?}, undef, $time );
|
|
if ($secret) {
|
|
$SecretCache{$memkey} = $secret;
|
|
LJ::MemCache::set( $memkey, $secret );
|
|
return $want_new ? ( $time, $secret ) : $secret;
|
|
}
|
|
|
|
# return if they specified an explicit time they wanted.
|
|
# (calling with no args means generate a new one if secret
|
|
# doesn't exist)
|
|
return undef unless $want_new;
|
|
|
|
# don't generate new times that don't fall in our granularity
|
|
return undef if $time % 3600;
|
|
|
|
$secret = LJ::rand_chars(32);
|
|
$dbh->do( q{INSERT IGNORE INTO secrets SET stime=?, secret=?}, undef, $time, $secret );
|
|
|
|
# check for races:
|
|
$secret = get_secret($time);
|
|
return ( $time, $secret );
|
|
}
|
|
|
|
sub is_web_context {
|
|
return 1 if $ENV{MOD_PERL};
|
|
return 1 if $DW::Request::cur_req;
|
|
return 0;
|
|
}
|
|
|
|
# loads an include file, given the bare name of the file.
|
|
# ($filename)
|
|
# returns the text of the file from memcache/db.
|
|
sub load_include {
|
|
my $file = shift;
|
|
return unless $file && $file =~ /^[a-zA-Z0-9-_\.]{1,255}$/;
|
|
|
|
# we handle, so first if memcache...
|
|
my $val = LJ::MemCache::get("includefile:$file");
|
|
return $val if $val;
|
|
|
|
# straight database hit
|
|
my $dbh = LJ::get_db_writer();
|
|
$val = $dbh->selectrow_array( "SELECT inctext FROM includetext " . "WHERE incname=?",
|
|
undef, $file );
|
|
LJ::MemCache::set( "includefile:$file", $val, time() + 3600 );
|
|
return $val if $val;
|
|
|
|
# if not in memcache, hit disk -- if it exists
|
|
my $filename = "$LJ::HTDOCS/inc/$file";
|
|
return unless -e $filename;
|
|
|
|
# get it and return it
|
|
open( INCFILE, $filename )
|
|
or return "Could not open include file: $file.";
|
|
{ local $/ = undef; $val = <INCFILE>; }
|
|
close INCFILE;
|
|
return $val;
|
|
}
|
|
|
|
# <LJFUNC>
|
|
# name: LJ::bit_breakdown
|
|
# des: Breaks down a bitmask into an array of bits enabled.
|
|
# args: mask
|
|
# des-mask: The number to break down.
|
|
# returns: A list of bits enabled. E.g., 3 returns (0, 2) indicating that bits 0 and 2 (numbering
|
|
# from the right) are currently on.
|
|
# </LJFUNC>
|
|
sub bit_breakdown {
|
|
my $mask = shift() + 0;
|
|
|
|
# check each bit 0..63 and return only ones that are defined
|
|
return grep { defined }
|
|
map { $mask & ( 1 << $_ ) ? $_ : undef } 0 .. 63;
|
|
}
|
|
|
|
sub last_error_code {
|
|
return $LJ::last_error;
|
|
}
|
|
|
|
sub last_error {
|
|
my $err = {
|
|
'utf8' => "Encoding isn't valid UTF-8",
|
|
'db' => "Database error",
|
|
'comm_not_found' => "Community not found",
|
|
'comm_not_comm' => "Account not a community",
|
|
'comm_not_member' => "User not a member of community",
|
|
'comm_invite_limit' => "Outstanding invitation limit reached",
|
|
'comm_user_has_banned' => "Unable to invite; user has banned community",
|
|
};
|
|
my $des = $err->{$LJ::last_error};
|
|
if ( $LJ::last_error eq "db" && $LJ::db_error ) {
|
|
$des .= ": $LJ::db_error";
|
|
}
|
|
return $des || $LJ::last_error;
|
|
}
|
|
|
|
sub error {
|
|
my $err = shift;
|
|
if ( LJ::DB::isdb($err) ) {
|
|
$LJ::db_error = $err->errstr;
|
|
$err = "db";
|
|
}
|
|
elsif ( $err eq "db" ) {
|
|
$LJ::db_error = "";
|
|
}
|
|
$LJ::last_error = $err;
|
|
return undef;
|
|
}
|
|
|
|
*errobj = \&LJ::Error::errobj;
|
|
*throw = \&LJ::Error::throw;
|
|
|
|
# Returns a LWP::UserAgent or LWP::UserAgent::Paranoid agent depending on role
|
|
# passed in by the caller.
|
|
# Des-%opts:
|
|
# role => what is this UA being used for? (required)
|
|
# timeout => seconds before request will timeout, defaults to 10
|
|
# max_size => maximum size of returned document, defaults to no limit
|
|
sub get_useragent {
|
|
my %opts = @_;
|
|
|
|
my $timeout = $opts{'timeout'} || 10;
|
|
my $max_size = $opts{'max_size'} || undef;
|
|
my $agent = $opts{'agent'};
|
|
my $role = $opts{'role'};
|
|
return unless $role;
|
|
|
|
my $lib = 'LWP::UserAgent::Paranoid';
|
|
$lib = $LJ::USERAGENT_LIB{$role} if defined $LJ::USERAGENT_LIB{$role};
|
|
|
|
eval "require $lib";
|
|
my $ua = $lib->new(
|
|
request_timeout => $timeout,
|
|
max_size => $max_size,
|
|
ssl_opts => {
|
|
|
|
# FIXME: we still need verify_hostname off. Investigate.
|
|
verify_hostname => 0,
|
|
|
|
# also needed for LWP::Protocol::https < 6.06
|
|
SSL_verify_mode => 0,
|
|
|
|
#ca_file => Mozilla::CA::SSL_ca_file()
|
|
}
|
|
);
|
|
|
|
#$ua->agent($agent) if $agent;
|
|
return $ua;
|
|
}
|
|
|
|
sub assert_is {
|
|
my ( $va, $ve ) = @_;
|
|
return 1 if $va eq $ve;
|
|
LJ::errobj(
|
|
"AssertIs",
|
|
expected => $ve,
|
|
actual => $va,
|
|
caller => [ caller() ]
|
|
)->throw;
|
|
}
|
|
|
|
# no_utf8_flag previously used pack('C*',unpack('C*', $_[0]))
|
|
# but that stopped working in Perl 5.10.
|
|
sub no_utf8_flag {
|
|
|
|
# tell Perl to ignore the SvUTF8 flag in this scope.
|
|
use bytes;
|
|
|
|
# make a copy of the input string that doesn't have the flag at all.
|
|
return substr( $_[0], 0 );
|
|
}
|
|
|
|
# return 1 if root caller is a test, else 0
|
|
sub in_test {
|
|
return $LJ::_T_CONFIG == 1 ? 1 : 0;
|
|
}
|
|
|
|
our $AUTOLOAD;
|
|
|
|
sub AUTOLOAD {
|
|
if ( $AUTOLOAD eq "LJ::send_mail" ) {
|
|
eval "use LJ::Sendmail;";
|
|
goto &$AUTOLOAD;
|
|
}
|
|
Carp::croak("Undefined subroutine: $AUTOLOAD");
|
|
}
|
|
|
|
sub conf_test {
|
|
my ( $conf, @args ) = @_;
|
|
return 0 unless $conf;
|
|
return $conf->(@args) if ref $conf eq "CODE";
|
|
return $conf;
|
|
}
|
|
|
|
sub is_enabled {
|
|
my $conf = shift;
|
|
if ( $conf eq 'payments' ) {
|
|
my $remote = LJ::get_remote();
|
|
return 1 if $remote && $remote->can_beta_payments;
|
|
}
|
|
return !LJ::conf_test( $LJ::DISABLED{$conf}, @_ ) + 0;
|
|
}
|
|
|
|
# document valid arguments for certain privs (using hooks)
|
|
# argument: name of priv
|
|
# returns: hashref of argname/argdesc, or just list of argnames if wantarray
|
|
sub list_valid_args {
|
|
my ($priv) = @_;
|
|
my $hr = {};
|
|
|
|
foreach ( LJ::Hooks::run_hooks( "privlist-add", $priv ) ) {
|
|
my $ret = $_->[0];
|
|
next unless $ret;
|
|
|
|
# merge all results
|
|
@{$hr}{ keys %$ret } = values %$ret;
|
|
}
|
|
|
|
# optionally allow someone to remove a listing that was provided elsewhere
|
|
foreach ( LJ::Hooks::run_hooks( "privlist-remove", $priv ) ) {
|
|
my @del = @$_;
|
|
|
|
# remove any keys listed by the hook
|
|
delete $hr->{$_} foreach @del;
|
|
}
|
|
|
|
return wantarray ? keys %$hr : $hr;
|
|
}
|
|
|
|
# END package LJ;
|
|
|
|
package LJ::Error::InvalidParameters;
|
|
sub opt_fields { qw(params) }
|
|
sub user_caused { 0 }
|
|
|
|
package LJ::Error::AssertIs;
|
|
sub fields { qw(expected actual caller) }
|
|
sub user_caused { 0 }
|
|
|
|
sub as_string {
|
|
my $self = shift;
|
|
my $caller = $self->field('caller');
|
|
my $ve = $self->field('expected');
|
|
my $va = $self->field('actual');
|
|
return
|
|
"Assertion failure at "
|
|
. join( ', ', (@$caller)[ 0 .. 2 ] )
|
|
. ": expected=$ve, actual=$va";
|
|
}
|
|
|
|
1;
|