init
This commit is contained in:
610
livejournal/cgi-bin/Apache/LiveJournal/Interface/AtomAPI.pm
Executable file
610
livejournal/cgi-bin/Apache/LiveJournal/Interface/AtomAPI.pm
Executable file
@@ -0,0 +1,610 @@
|
||||
# AtomAPI support for LJ
|
||||
|
||||
package Apache::LiveJournal::Interface::AtomAPI;
|
||||
|
||||
use strict;
|
||||
use Apache::Constants qw(:common);
|
||||
use Digest::SHA1;
|
||||
use MIME::Base64;
|
||||
use lib "$ENV{'LJHOME'}/cgi-bin";
|
||||
require 'parsefeed.pl';
|
||||
require 'fbupload.pl';
|
||||
|
||||
BEGIN {
|
||||
$LJ::OPTMOD_XMLATOM = eval q{
|
||||
use XML::Atom::Feed;
|
||||
use XML::Atom::Entry;
|
||||
use XML::Atom::Link;
|
||||
XML::Atom->VERSION < 0.09 ? 0 : 1;
|
||||
};
|
||||
};
|
||||
|
||||
# check allowed Atom upload filetypes
|
||||
sub check_mime
|
||||
{
|
||||
my $mime = shift;
|
||||
return unless $mime;
|
||||
|
||||
# TODO: add audio/etc support
|
||||
my %allowed_mime = (
|
||||
image => qr{^image\/(?:gif|jpe?g|png|tiff?)$}i,
|
||||
#audio => qr{^(?:application|audio)\/(?:(?:x-)?ogg|wav)$}i
|
||||
);
|
||||
|
||||
foreach (keys %allowed_mime) {
|
||||
return $_ if $mime =~ $allowed_mime{$_}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub respond {
|
||||
my ($r, $status, $body, $type) = @_;
|
||||
|
||||
my %msgs = (
|
||||
200 => 'OK',
|
||||
201 => 'Created',
|
||||
|
||||
400 => 'Bad Request',
|
||||
401 => 'Authentication Failed',
|
||||
403 => 'Forbidden',
|
||||
404 => 'Not Found',
|
||||
500 => 'Server Error',
|
||||
),
|
||||
|
||||
my %mime = (
|
||||
html => 'text/html',
|
||||
atom => 'application/x.atom+xml',
|
||||
xml => "text/xml; charset='utf-8'",
|
||||
);
|
||||
|
||||
# if the passed in body was a reference, send it
|
||||
# without any modification. otherwise, send some
|
||||
# prettier html to the client.
|
||||
my $out;
|
||||
if (ref $body) {
|
||||
$out = $$body;
|
||||
} else {
|
||||
$out = <<HTML;
|
||||
<html><head><title>$status $msgs{$status}</title></head><body>
|
||||
<h1>$msgs{$status}</h1><hr /><p>$body</p>
|
||||
</body></html>
|
||||
HTML
|
||||
}
|
||||
|
||||
$type = $mime{$type} || 'text/html';
|
||||
$r->status_line("$status $msgs{$status}");
|
||||
$r->content_type($type);
|
||||
$r->send_http_header();
|
||||
$r->print($out);
|
||||
return OK;
|
||||
};
|
||||
|
||||
sub handle_upload
|
||||
{
|
||||
my ($r, $remote, $u, $opts, $entry) = @_;
|
||||
|
||||
# entry could already be populated from a standalone
|
||||
# service.post posting.
|
||||
my $standalone = $entry ? 1 : 0;
|
||||
unless ($entry) {
|
||||
my $buff;
|
||||
$r->read($buff, $r->header_in("Content-length"));
|
||||
|
||||
eval { $entry = XML::Atom::Entry->new( \$buff ); };
|
||||
return respond($r, 400, "Could not parse the entry due to invalid markup.<br /><pre>$@</pre>")
|
||||
if $@;
|
||||
}
|
||||
|
||||
my $mime = $entry->content()->type();
|
||||
my $mime_area = check_mime( $mime );
|
||||
return respond($r, 400, "Unsupported MIME type: $mime") unless $mime_area;
|
||||
|
||||
if ($mime_area eq 'image') {
|
||||
|
||||
return respond($r, 400, "Unable to upload media. Your account doesn't have the required access.")
|
||||
unless LJ::get_cap($u, 'fb_can_upload') && $LJ::FB_SITEROOT;
|
||||
|
||||
my $err;
|
||||
LJ::load_user_props(
|
||||
$u,
|
||||
qw/ emailpost_gallery emailpost_imgsecurity /
|
||||
);
|
||||
|
||||
my $summary = LJ::trim( $entry->summary() );
|
||||
|
||||
my $fb = LJ::FBUpload::do_upload(
|
||||
$u, \$err,
|
||||
{
|
||||
path => $entry->title(),
|
||||
rawdata => \$entry->content()->body(),
|
||||
imgsec => $u->{emailpost_imgsecurity},
|
||||
caption => $summary,
|
||||
galname => $u->{emailpost_gallery} || 'AtomUpload',
|
||||
}
|
||||
);
|
||||
|
||||
return respond($r, 500, "There was an error uploading the media: $err")
|
||||
if $err || ! $fb;
|
||||
|
||||
if (ref $fb && $fb->{Error}->{code}) {
|
||||
my $errstr = $fb->{Error}->{content};
|
||||
return respond($r, 500, "There was an error uploading the media: $errstr");
|
||||
}
|
||||
|
||||
my $atom_reply = XML::Atom::Entry->new();
|
||||
$atom_reply->title( $fb->{Title} );
|
||||
|
||||
if ($standalone) {
|
||||
$atom_reply->summary('Media post');
|
||||
my $id = "atom:$u->{user}:$fb->{PicID}";
|
||||
$fb->{Summary} = $summary;
|
||||
LJ::MemCache::set( $id, $fb, 1800 );
|
||||
$atom_reply->id( "urn:fb:$LJ::FB_DOMAIN:$id" );
|
||||
}
|
||||
|
||||
my $link = XML::Atom::Link->new();
|
||||
$link->type('text/html');
|
||||
$link->rel('alternate');
|
||||
$link->href( $fb->{URL} );
|
||||
$atom_reply->add_link($link);
|
||||
|
||||
$r->header_out("Location", $fb->{URL});
|
||||
return respond($r, 201, \$atom_reply->as_xml(), 'atom');
|
||||
}
|
||||
}
|
||||
|
||||
sub handle_post {
|
||||
my ($r, $remote, $u, $opts) = @_;
|
||||
my ($buff, $entry);
|
||||
|
||||
# read the content
|
||||
$r->read($buff, $r->header_in("Content-length"));
|
||||
|
||||
# try parsing it
|
||||
eval { $entry = XML::Atom::Entry->new( \$buff ); };
|
||||
return respond($r, 400, "Could not parse the entry due to invalid markup.<br /><pre>$@</pre>")
|
||||
if $@;
|
||||
|
||||
# on post, the entry must NOT include an id
|
||||
return respond($r, 400, "Must not include an <b><id></b> field in a new entry.")
|
||||
if $entry->id();
|
||||
|
||||
# detect 'standalone' media posts
|
||||
return handle_upload( @_, $entry )
|
||||
if $entry->get("http://sixapart.com/atom/typepad#", 'standalone');
|
||||
|
||||
# remove the SvUTF8 flag. See same code in synsuck.pl for
|
||||
# an explanation
|
||||
$entry->title( pack( 'C*', unpack( 'C*', $entry->title() ) ) );
|
||||
$entry->link( pack( 'C*', unpack( 'C*', $entry->link() ) ) );
|
||||
$entry->content( pack( 'C*', unpack( 'C*', $entry->content()->body() ) ) );
|
||||
|
||||
# Retrieve fotobilder media links from clients that embed via
|
||||
# standalone tags or service.upload transfers. Add to post entry
|
||||
# body.
|
||||
my $body = $entry->content()->body();
|
||||
my @links = $entry->link();
|
||||
my (@images, $link_count);
|
||||
foreach my $link (@links) {
|
||||
# $link is now a valid XML::Atom::Link object
|
||||
my $rel = $link->get('rel');
|
||||
my $type = $link->get('type');
|
||||
my $id = $link->get('href');
|
||||
|
||||
next unless $rel eq 'related' && check_mime($type) && $id;
|
||||
$id =~ s/^urn:fb:$LJ::FB_DOMAIN://;
|
||||
my $fb = LJ::MemCache::get( $id );
|
||||
next unless $fb;
|
||||
|
||||
push @images, {
|
||||
url => $fb->{URL},
|
||||
width => $fb->{Width},
|
||||
height => $fb->{Height},
|
||||
caption => $fb->{Summary},
|
||||
title => $fb->{Title}
|
||||
};
|
||||
}
|
||||
|
||||
$body .= LJ::FBUpload::make_html( $u, \@images );
|
||||
|
||||
# build a post event request.
|
||||
my $req = {
|
||||
'usejournal' => ( $remote->{'userid'} != $u->{'userid'} ) ? $u->{'user'} : undef,
|
||||
'ver' => 1,
|
||||
'username' => $u->{'user'},
|
||||
'lineendings' => 'unix',
|
||||
'subject' => $entry->title(),
|
||||
'event' => $body,
|
||||
'props' => {},
|
||||
'security' => 'public',
|
||||
'tz' => 'guess',
|
||||
};
|
||||
|
||||
my $err;
|
||||
my $res = LJ::Protocol::do_request("postevent",
|
||||
$req, \$err, { 'noauth' => 1 });
|
||||
|
||||
if ($err) {
|
||||
my $errstr = LJ::Protocol::error_message($err);
|
||||
return respond($r, 500, "Unable to post new entry. Protocol error: <b>$errstr</b>.");
|
||||
}
|
||||
|
||||
my $atom_reply = XML::Atom::Entry->new();
|
||||
$atom_reply->title( $entry->title() );
|
||||
$atom_reply->summary( substr( $entry->content->body(), 0, 100 ) );
|
||||
|
||||
my $link;
|
||||
my $edit_url = "$LJ::SITEROOT/interface/atom/edit/$res->{'itemid'}";
|
||||
|
||||
$link = XML::Atom::Link->new();
|
||||
$link->type('application/x.atom+xml');
|
||||
$link->rel('service.edit');
|
||||
$link->href( $edit_url );
|
||||
$link->title( $entry->title() );
|
||||
$atom_reply->add_link($link);
|
||||
|
||||
$link = XML::Atom::Link->new();
|
||||
$link->type('text/html');
|
||||
$link->rel('alternate');
|
||||
$link->href( $res->{url} );
|
||||
$link->title( $entry->title() );
|
||||
$atom_reply->add_link($link);
|
||||
|
||||
$r->header_out("Location", $edit_url);
|
||||
return respond($r, 201, \$atom_reply->as_xml(), 'atom');
|
||||
}
|
||||
|
||||
sub handle_edit {
|
||||
my ($r, $remote, $u, $opts) = @_;
|
||||
|
||||
my $method = $opts->{'method'};
|
||||
|
||||
# first, try to load the item and fail if it's not there
|
||||
my $jitemid = $opts->{'param'};
|
||||
my $req = {
|
||||
'usejournal' => ($remote->{'userid'} != $u->{'userid'}) ?
|
||||
$u->{'user'} : undef,
|
||||
'ver' => 1,
|
||||
'username' => $u->{'user'},
|
||||
'selecttype' => 'one',
|
||||
'itemid' => $jitemid,
|
||||
};
|
||||
|
||||
my $err;
|
||||
my $olditem = LJ::Protocol::do_request("getevents",
|
||||
$req, \$err, { 'noauth' => 1 });
|
||||
|
||||
if ($err) {
|
||||
my $errstr = LJ::Protocol::error_message($err);
|
||||
return respond($r, 404, "Unable to retrieve the item requested for editing. Protocol error: <b>$errstr</b>.");
|
||||
}
|
||||
$olditem = $olditem->{'events'}->[0];
|
||||
|
||||
if ($method eq "GET") {
|
||||
# return an AtomEntry for this item
|
||||
# use the interface between make_feed and create_view_atom in
|
||||
# ljfeed.pl
|
||||
|
||||
# get the log2 row (need logtime for createtime)
|
||||
my $row = LJ::get_log2_row($u, $jitemid) ||
|
||||
return respond($r, 404, "Could not load the original entry.");
|
||||
|
||||
# we need to put into $item: itemid, ditemid, subject, event,
|
||||
# createtime, eventtime, modtime
|
||||
|
||||
my $ctime = LJ::mysqldate_to_time($row->{'logtime'}, 1);
|
||||
|
||||
my $item = {
|
||||
'itemid' => $olditem->{'itemid'},
|
||||
'ditemid' => $olditem->{'itemid'}*256 + $olditem->{'anum'},
|
||||
'eventtime' => LJ::alldatepart_s2($row->{'eventtime'}),
|
||||
'createtime' => $ctime,
|
||||
'modtime' => $olditem->{'props'}->{'revtime'} || $ctime,
|
||||
'subject' => $olditem->{'subject'},
|
||||
'event' => $olditem->{'event'},
|
||||
};
|
||||
|
||||
my $ret = LJ::Feed::create_view_atom(
|
||||
{ 'u' => $u },
|
||||
$u,
|
||||
{
|
||||
'saycharset' => "utf-8",
|
||||
'noheader' => 1,
|
||||
'apilinks' => 1,
|
||||
},
|
||||
[$item]
|
||||
);
|
||||
|
||||
return respond($r, 200, \$ret, 'xml');
|
||||
}
|
||||
|
||||
if ($method eq "PUT") {
|
||||
# read the content
|
||||
my $buff;
|
||||
$r->read($buff, $r->header_in("Content-length"));
|
||||
|
||||
# try parsing it
|
||||
my $entry;
|
||||
eval { $entry = XML::Atom::Entry->new( \$buff ); };
|
||||
return respond($r, 400, "Could not parse the entry due to invalid markup.<br /><pre>$@</pre>")
|
||||
if $@;
|
||||
|
||||
# remove the SvUTF8 flag. See same code in synsuck.pl for
|
||||
# an explanation
|
||||
$entry->title( pack( 'C*', unpack( 'C*', $entry->title() ) ) );
|
||||
$entry->link( pack( 'C*', unpack( 'C*', $entry->link() ) ) );
|
||||
$entry->content( pack( 'C*', unpack( 'C*', $entry->content()->body() ) ) );
|
||||
|
||||
# the AtomEntry must include <id> which must match the one we sent
|
||||
# on GET
|
||||
unless ($entry->id() =~ m#atom1:$u->{'user'}:(\d+)$# &&
|
||||
$1 == $olditem->{'itemid'}*256 + $olditem->{'anum'}) {
|
||||
return respond($r, 400, "Incorrect <b><id></b> field in this request.");
|
||||
}
|
||||
|
||||
# build an edit event request. Preserve fields that aren't being
|
||||
# changed by this item (perhaps the AtomEntry isn't carrying the
|
||||
# complete information).
|
||||
|
||||
$req = {
|
||||
'usejournal' => ( $remote->{'userid'} != $u->{'userid'} ) ? $u->{'user'} : undef,
|
||||
'ver' => 1,
|
||||
'username' => $u->{'user'},
|
||||
'itemid' => $jitemid,
|
||||
'lineendings' => 'unix',
|
||||
'subject' => $entry->title() || $olditem->{'subject'},
|
||||
'event' => $entry->content()->body() || $olditem->{'event'},
|
||||
'props' => $olditem->{'props'},
|
||||
'security' => $olditem->{'security'},
|
||||
'allowmask' => $olditem->{'allowmask'},
|
||||
};
|
||||
|
||||
$err = undef;
|
||||
my $res = LJ::Protocol::do_request("editevent",
|
||||
$req, \$err, { 'noauth' => 1 });
|
||||
|
||||
if ($err) {
|
||||
my $errstr = LJ::Protocol::error_message($err);
|
||||
return respond($r, 500, "Unable to update entry. Protocol error: <b>$errstr</b>.");
|
||||
}
|
||||
|
||||
return respond($r, 200, "The entry was successfully updated.");
|
||||
}
|
||||
|
||||
if ($method eq "DELETE") {
|
||||
|
||||
# build an edit event request to delete the entry.
|
||||
|
||||
$req = {
|
||||
'usejournal' => ($remote->{'userid'} != $u->{'userid'}) ?
|
||||
$u->{'user'}:undef,
|
||||
'ver' => 1,
|
||||
'username' => $u->{'user'},
|
||||
'itemid' => $jitemid,
|
||||
'lineendings' => 'unix',
|
||||
'event' => '',
|
||||
};
|
||||
|
||||
$err = undef;
|
||||
my $res = LJ::Protocol::do_request("editevent",
|
||||
$req, \$err, { 'noauth' => 1 });
|
||||
|
||||
if ($err) {
|
||||
my $errstr = LJ::Protocol::error_message($err);
|
||||
return respond($r, 500, "Unable to delete entry. Protocol error: <b>$errstr</b>.");
|
||||
}
|
||||
|
||||
return respond($r, 200, "Entry successfully deleted.");
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
# fetch lj tags, display as categories
|
||||
sub handle_categories
|
||||
{
|
||||
my ($r, $remote, $u, $opts) = @_;
|
||||
my $ret = '<?xml version="1.0"?>';
|
||||
$ret .= '<categories xmlns="http://sixapart.com/atom/category#">';
|
||||
|
||||
my $tags = LJ::Tags::get_usertags($u, { remote => $remote }) || {};
|
||||
foreach (sort { $a->{name} cmp $b->{name} } values %$tags) {
|
||||
$ret .= "<subject xmlns=\"http://purl.org/dc/elements/1.1/\">$_->{name}</subject>";
|
||||
}
|
||||
$ret .= '</categories>';
|
||||
|
||||
return respond($r, 200, \$ret, 'xml');
|
||||
}
|
||||
|
||||
sub handle_feed {
|
||||
my ($r, $remote, $u, $opts) = @_;
|
||||
|
||||
# simulate a call to the S1 data view creator, with appropriate
|
||||
# options
|
||||
|
||||
my %op = ('pathextra' => "/atom",
|
||||
'saycharset'=> "utf-8",
|
||||
'apilinks' => 1,
|
||||
);
|
||||
my $ret = LJ::Feed::make_feed($r, $u, $remote, \%op);
|
||||
|
||||
unless (defined $ret) {
|
||||
if ($op{'redir'}) {
|
||||
# this happens if the account was renamed or a syn account.
|
||||
# the redir URL is wrong because ljfeed.pl is too
|
||||
# dataview-specific. Since this is an admin interface, we can
|
||||
# just fail.
|
||||
return respond ($r, 404, "The account <b>$u->{'user'} </b> is of a wrong type and does not allow AtomAPI administration.");
|
||||
}
|
||||
if ($op{'handler_return'}) {
|
||||
# this could be a conditional GET shortcut, honor it
|
||||
$r->status($op{'handler_return'});
|
||||
return OK;
|
||||
}
|
||||
# should never get here
|
||||
return respond ($r, 404, "Unknown error.");
|
||||
}
|
||||
|
||||
# everything's fine, return the XML body with the correct content type
|
||||
return respond($r, 200, \$ret, 'xml');
|
||||
|
||||
}
|
||||
|
||||
# this routine accepts the apache request handle, performs
|
||||
# authentication, calls the appropriate method handler, and
|
||||
# prints the response.
|
||||
sub handle {
|
||||
my $r = shift;
|
||||
|
||||
return respond($r, 404, "This server does not support the Atom API.")
|
||||
unless $LJ::OPTMOD_XMLATOM;
|
||||
|
||||
# break the uri down: /interface/atom/<verb>[/<number>]
|
||||
my ( $action, $param, $oldparam ) = ( $1, $2, $3 )
|
||||
if $r->uri =~ m#^/interface/atom(?:api)?/?(\w+)?(?:/(\w+))?(?:/(\d+))?$#;
|
||||
|
||||
my $valid_actions = qr{feed|edit|post|upload|categories};
|
||||
|
||||
# old uri was was: /interface/atomapi/<username>/<verb>[/<number>]
|
||||
# support both by shifting params around if we see something extra.
|
||||
if ($action !~ /$valid_actions/ && $r->uri =~ /atomapi/ ) {
|
||||
$action = $param;
|
||||
$param = $oldparam;
|
||||
}
|
||||
|
||||
# let's authenticate.
|
||||
#
|
||||
# if wsse information is supplied, use it.
|
||||
# if not, fall back to digest.
|
||||
my $wsse = $r->header_in('X-WSSE');
|
||||
my $nonce_dup;
|
||||
my $u = $wsse ? auth_wsse($wsse, \$nonce_dup) : LJ::auth_digest($r);
|
||||
return respond( $r, 401, "Authentication failed for this AtomAPI request.")
|
||||
unless $u;
|
||||
|
||||
return respond( $r, 401, "Authentication failed for this AtomAPI request.")
|
||||
if $nonce_dup && $action && $action ne 'post';
|
||||
|
||||
# service autodiscovery
|
||||
# TODO: Add communities?
|
||||
my $method = $r->method;
|
||||
if ( $method eq 'GET' && ! $action ) {
|
||||
LJ::load_user_props( $u, 'journaltitle' );
|
||||
my $title = $u->{journaltitle} || 'Untitled Journal';
|
||||
my $feed = XML::Atom::Feed->new();
|
||||
foreach (qw/ post feed upload categories /) {
|
||||
my $link = XML::Atom::Link->new();
|
||||
$link->title($title);
|
||||
$link->type('application/x.atom+xml');
|
||||
$link->rel("service.$_");
|
||||
$link->href("$LJ::SITEROOT/interface/atom/$_");
|
||||
$feed->add_link($link);
|
||||
}
|
||||
my $link = XML::Atom::Link->new();
|
||||
$link->title($title);
|
||||
$link->type('text/html');
|
||||
$link->rel('alternate');
|
||||
$link->href( LJ::journal_base($u) );
|
||||
$feed->add_link($link);
|
||||
|
||||
return respond($r, 200, \$feed->as_xml(), 'atom');
|
||||
}
|
||||
|
||||
$action =~ /$valid_actions/
|
||||
or return respond($r, 400, "Unknown URI scheme: /interface/atom/<b>$action</b>");
|
||||
|
||||
unless (($action eq 'feed' and $method eq 'GET') or
|
||||
($action eq 'categories' and $method eq 'GET') or
|
||||
($action eq 'post' and $method eq 'POST') or
|
||||
($action eq 'upload' and $method eq 'POST') or
|
||||
($action eq 'edit' and
|
||||
{'GET'=>1,'PUT'=>1,'DELETE'=>1}->{$method})) {
|
||||
return respond($r, 400, "URI scheme /interface/atom/<b>$action</b> is incompatible with request method <b>$method</b>.");
|
||||
}
|
||||
|
||||
if (($action ne 'edit' && $param) or
|
||||
($action eq 'edit' && $param !~ m#^\d+$#)) {
|
||||
return respond($r, 400, "Either the URI lacks a required parameter, or its format is improper.");
|
||||
}
|
||||
|
||||
# we've authenticated successfully and remote is set. But can remote
|
||||
# manage the requested account?
|
||||
my $remote = LJ::get_remote();
|
||||
unless (LJ::can_manage($remote, $u)) {
|
||||
return respond($r, 403, "User <b>$remote->{'user'}</b> has no administrative access to account <b>$u->{user}</b>.");
|
||||
}
|
||||
|
||||
# handle the requested action
|
||||
my $opts = {
|
||||
'action' => $action,
|
||||
'method' => $method,
|
||||
'param' => $param
|
||||
};
|
||||
|
||||
{
|
||||
'feed' => \&handle_feed,
|
||||
'post' => \&handle_post,
|
||||
'edit' => \&handle_edit,
|
||||
'upload' => \&handle_upload,
|
||||
'categories' => \&handle_categories,
|
||||
}->{$action}->( $r, $remote, $u, $opts );
|
||||
|
||||
return OK;
|
||||
}
|
||||
|
||||
# Authenticate via the WSSE header.
|
||||
# Returns valid $u on success, undef on failure.
|
||||
sub auth_wsse
|
||||
{
|
||||
my ($wsse, $nonce_dup) = @_;
|
||||
$wsse =~ s/UsernameToken // or return undef;
|
||||
|
||||
# parse credentials into a hash.
|
||||
my %creds;
|
||||
foreach (split /, /, $wsse) {
|
||||
my ($k, $v) = split '=', $_, 2;
|
||||
$v =~ s/^['"]//;
|
||||
$v =~ s/['"]$//;
|
||||
$v =~ s/=$// if $k =~ /passworddigest/i; # strip base64 newline char
|
||||
$creds{ lc($k) } = $v;
|
||||
}
|
||||
|
||||
# invalid create time? invalid wsse.
|
||||
my $ctime = LJ::ParseFeed::w3cdtf_to_time( $creds{created} ) or return undef;
|
||||
|
||||
# prevent replay attacks.
|
||||
$ctime = LJ::mysqldate_to_time( $ctime, 'gmt' );
|
||||
return undef if abs(time() - $ctime) > 42300;
|
||||
|
||||
my $u = LJ::load_user( LJ::canonical_username( $creds{'username'} ) )
|
||||
or return undef;
|
||||
|
||||
if (@LJ::MEMCACHE_SERVERS && ref $nonce_dup) {
|
||||
$$nonce_dup = 1
|
||||
unless LJ::MemCache::add( "wsse_auth:$creds{username}:$creds{nonce}", 1, 180 )
|
||||
}
|
||||
|
||||
# validate hash
|
||||
my $hash =
|
||||
Digest::SHA1::sha1_base64(
|
||||
$creds{nonce} . $creds{created} . $u->{password} );
|
||||
|
||||
# Nokia's WSSE implementation is incorrect as of 1.5, and they
|
||||
# base64 encode their nonce *value*. If the initial comparison
|
||||
# fails, we need to try this as well before saying it's invalid.
|
||||
if ($hash ne $creds{passworddigest}) {
|
||||
|
||||
$hash =
|
||||
Digest::SHA1::sha1_base64(
|
||||
MIME::Base64::decode_base64( $creds{nonce} ) .
|
||||
$creds{created} .
|
||||
$u->{password} );
|
||||
|
||||
return undef if $hash ne $creds{passworddigest};
|
||||
}
|
||||
|
||||
# If we're here, we're valid.
|
||||
LJ::set_remote($u);
|
||||
return $u;
|
||||
}
|
||||
|
||||
1;
|
||||
232
livejournal/cgi-bin/Apache/LiveJournal/Interface/Blogger.pm
Executable file
232
livejournal/cgi-bin/Apache/LiveJournal/Interface/Blogger.pm
Executable file
@@ -0,0 +1,232 @@
|
||||
# Blogger API wrapper for LJ
|
||||
|
||||
use strict;
|
||||
package LJ::Util;
|
||||
|
||||
sub blogger_deserialize {
|
||||
my $content = shift;
|
||||
my $event = { 'props' => {} };
|
||||
if ($content =~ s!<title>(.*?)</title>!!) {
|
||||
$event->{'subject'} = $1;
|
||||
}
|
||||
if ($content =~ s/(^|\n)lj-mood:\s*(.*)\n//i) {
|
||||
$event->{'props'}->{'current_mood'} = $2;
|
||||
}
|
||||
if ($content =~ s/(^|\n)lj-music:\s*(.*)\n//i) {
|
||||
$event->{'props'}->{'current_music'} = $2;
|
||||
}
|
||||
$content =~ s/^\s+//; $content =~ s/\s+$//;
|
||||
$event->{'event'} = $content;
|
||||
return $event;
|
||||
}
|
||||
|
||||
sub blogger_serialize {
|
||||
my $event = shift;
|
||||
my $header;
|
||||
my $content;
|
||||
if ($event->{'subject'}) {
|
||||
$header .= "<title>$event->{'subject'}</title>";
|
||||
}
|
||||
if ($event->{'props'}->{'current_mood'}) {
|
||||
$header .= "lj-mood: $event->{'props'}->{'current_mood'}\n";
|
||||
}
|
||||
if ($event->{'props'}->{'current_music'}) {
|
||||
$header .= "lj-music: $event->{'props'}->{'current_music'}\n";
|
||||
}
|
||||
$content .= "$header\n" if $header;
|
||||
$content .= $event->{'event'};
|
||||
return $content;
|
||||
}
|
||||
|
||||
# ISO 8601 (many formats available)
|
||||
# "yyyy-mm-dd hh:mm:ss" => "yyyymmddThh:mm:ss" (literal T)
|
||||
sub mysql_date_to_iso {
|
||||
my $dt = shift;
|
||||
$dt =~ s/ /T/;
|
||||
$dt =~ s/\-//g;
|
||||
return $dt;
|
||||
}
|
||||
|
||||
package Apache::LiveJournal::Interface::Blogger;
|
||||
|
||||
sub newPost {
|
||||
shift;
|
||||
my ($appkey, $journal, $user, $password, $content, $publish) = @_;
|
||||
|
||||
my $err;
|
||||
my $event = LJ::Util::blogger_deserialize($content);
|
||||
|
||||
my $req = {
|
||||
'usejournal' => $journal ne $user ? $journal : undef,
|
||||
'ver' => 1,
|
||||
'username' => $user,
|
||||
'password' => $password,
|
||||
'event' => $event->{'event'},
|
||||
'subject' => $event->{'subject'},
|
||||
'props' => $event->{'props'},
|
||||
'tz' => 'guess',
|
||||
};
|
||||
|
||||
my $res = LJ::Protocol::do_request("postevent", $req, \$err);
|
||||
|
||||
if ($err) {
|
||||
die SOAP::Fault
|
||||
->faultstring(LJ::Protocol::error_message($err))
|
||||
->faultcode(substr($err, 0, 3));
|
||||
}
|
||||
|
||||
return "$journal:$res->{'itemid'}";
|
||||
}
|
||||
|
||||
sub deletePost {
|
||||
shift;
|
||||
my ($appkey, $postid, $user, $password, $content, $publish) = @_;
|
||||
return editPost(undef, $appkey, $postid, $user, $password, "", $publish);
|
||||
}
|
||||
|
||||
sub editPost {
|
||||
shift;
|
||||
my ($appkey, $postid, $user, $password, $content, $publish) = @_;
|
||||
|
||||
die "Invalid postid\n" unless $postid =~ /^(\w+):(\d+)$/;
|
||||
my ($journal, $itemid) = ($1, $2);
|
||||
|
||||
my $event = LJ::Util::blogger_deserialize($content);
|
||||
|
||||
my $req = {
|
||||
'usejournal' => $journal ne $user ? $journal : undef,
|
||||
'ver' => 1,
|
||||
'username' => $user,
|
||||
'password' => $password,
|
||||
'event' => $event->{'event'},
|
||||
'subject' => $event->{'subject'},
|
||||
'props' => $event->{'props'},
|
||||
'itemid' => $itemid,
|
||||
};
|
||||
|
||||
my $err;
|
||||
my $res = LJ::Protocol::do_request("editevent", $req, \$err);
|
||||
|
||||
if ($err) {
|
||||
die SOAP::Fault
|
||||
->faultstring(LJ::Protocol::error_message($err))
|
||||
->faultcode(substr($err, 0, 3));
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub getUsersBlogs {
|
||||
shift;
|
||||
my ($appkey, $user, $password) = @_;
|
||||
|
||||
my $u = LJ::load_user($user) or die "Invalid login\n";
|
||||
die "Invalid login\n" unless LJ::auth_okay($u, $password);
|
||||
|
||||
my $ids = LJ::load_rel_target($u, 'P');
|
||||
my $us = LJ::load_userids(@$ids);
|
||||
my @list = ($u);
|
||||
foreach (sort { $a->{user} cmp $b->{user} } values %$us) {
|
||||
next unless $_->{'statusvis'} eq "V";
|
||||
push @list, $_;
|
||||
}
|
||||
|
||||
return [ map { {
|
||||
'url' => LJ::journal_base($_) . "/",
|
||||
'blogid' => $_->{'user'},
|
||||
'blogName' => $_->{'name'},
|
||||
} } @list ];
|
||||
}
|
||||
|
||||
sub getRecentPosts {
|
||||
shift;
|
||||
my ($appkey, $journal, $user, $password, $numposts) = @_;
|
||||
|
||||
$numposts = int($numposts);
|
||||
$numposts = 1 if $numposts < 1;
|
||||
$numposts = 50 if $numposts > 50;
|
||||
|
||||
my $req = {
|
||||
'usejournal' => $journal ne $user ? $journal : undef,
|
||||
'ver' => 1,
|
||||
'username' => $user,
|
||||
'password' => $password,
|
||||
'selecttype' => 'lastn',
|
||||
'howmany' => $numposts,
|
||||
};
|
||||
|
||||
my $err;
|
||||
my $res = LJ::Protocol::do_request("getevents", $req, \$err);
|
||||
|
||||
if ($err) {
|
||||
die SOAP::Fault
|
||||
->faultstring(LJ::Protocol::error_message($err))
|
||||
->faultcode(substr($err, 0, 3));
|
||||
}
|
||||
|
||||
return [ map { {
|
||||
'content' => LJ::Util::blogger_serialize($_),
|
||||
'userID' => $_->{'poster'} || $journal,
|
||||
'postId' => "$journal:$_->{'itemid'}",
|
||||
'dateCreated' => LJ::Util::mysql_date_to_iso($_->{'eventtime'}),
|
||||
} } @{$res->{'events'}} ];
|
||||
}
|
||||
|
||||
sub getPost {
|
||||
shift;
|
||||
my ($appkey, $postid, $user, $password) = @_;
|
||||
|
||||
die "Invalid postid\n" unless $postid =~ /^(\w+):(\d+)$/;
|
||||
my ($journal, $itemid) = ($1, $2);
|
||||
|
||||
my $req = {
|
||||
'usejournal' => $journal ne $user ? $journal : undef,
|
||||
'ver' => 1,
|
||||
'username' => $user,
|
||||
'password' => $password,
|
||||
'selecttype' => 'one',
|
||||
'itemid' => $itemid,
|
||||
};
|
||||
|
||||
my $err;
|
||||
my $res = LJ::Protocol::do_request("getevents", $req, \$err);
|
||||
|
||||
if ($err) {
|
||||
die SOAP::Fault
|
||||
->faultstring(LJ::Protocol::error_message($err))
|
||||
->faultcode(substr($err, 0, 3));
|
||||
}
|
||||
|
||||
die "Post not found\n" unless $res->{'events'}->[0];
|
||||
|
||||
return map { {
|
||||
'content' => LJ::Util::blogger_serialize($_),
|
||||
'userID' => $_->{'poster'} || $journal,
|
||||
'postId' => "$journal:$_->{'itemid'}",
|
||||
'dateCreated' => LJ::Util::mysql_date_to_iso($_->{'eventtime'}),
|
||||
} } $res->{'events'}->[0];
|
||||
}
|
||||
|
||||
sub getTemplate { die "$LJ::SITENAME doesn't support Blogger Templates. To customize your journal, visit $LJ::SITENAME/customize/"; }
|
||||
*setTemplate = \&getTemplate;
|
||||
|
||||
sub getUserInfo {
|
||||
shift;
|
||||
my ($appkey, $user, $password) = @_;
|
||||
|
||||
my $u = LJ::load_user($user) or die "Invalid login\n";
|
||||
die "Invalid login\n" unless LJ::auth_okay($u, $password);
|
||||
|
||||
LJ::load_user_props($u, "url");
|
||||
|
||||
return {
|
||||
'userid' => $u->{'userid'},
|
||||
'nickname' => $u->{'user'},
|
||||
'firstname' => $u->{'name'},
|
||||
'lastname' => $u->{'name'},
|
||||
'email' => $u->{'email'},
|
||||
'url' => $u->{'url'},
|
||||
};
|
||||
}
|
||||
|
||||
1;
|
||||
207
livejournal/cgi-bin/Apache/LiveJournal/Interface/FotoBilder.pm
Executable file
207
livejournal/cgi-bin/Apache/LiveJournal/Interface/FotoBilder.pm
Executable file
@@ -0,0 +1,207 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
package Apache::LiveJournal::Interface::FotoBilder;
|
||||
|
||||
use strict;
|
||||
use Apache::Constants qw(:common REDIRECT HTTP_NOT_MODIFIED
|
||||
HTTP_MOVED_PERMANENTLY BAD_REQUEST);
|
||||
|
||||
sub run_method
|
||||
{
|
||||
my $cmd = shift;
|
||||
|
||||
# Available functions for this interface.
|
||||
my $interface = {
|
||||
'checksession' => \&checksession,
|
||||
'get_user_info' => \&get_user_info,
|
||||
'makechals' => \&makechals,
|
||||
'set_quota' => \&set_quota,
|
||||
'user_exists' => \&user_exists,
|
||||
'get_auth_challenge' => \&get_auth_challenge,
|
||||
'get_groups' => \&get_groups,
|
||||
};
|
||||
return undef unless $interface->{$cmd};
|
||||
|
||||
return $interface->{$cmd}->(@_);
|
||||
}
|
||||
|
||||
sub handler
|
||||
{
|
||||
my $r = shift;
|
||||
my $uri = $r->uri;
|
||||
return 404 unless $uri =~ m#^/interface/fotobilder(?:/(\w+))?$#;
|
||||
my $cmd = $1;
|
||||
|
||||
return BAD_REQUEST unless $r->method eq "POST";
|
||||
|
||||
$r->content_type("text/plain");
|
||||
$r->send_http_header();
|
||||
|
||||
my %POST = $r->content;
|
||||
my $res = run_method($cmd, \%POST)
|
||||
or return BAD_REQUEST;
|
||||
|
||||
$res->{"fotobilder-interface-version"} = 1;
|
||||
|
||||
$r->print(join("", map { "$_: $res->{$_}\n" } keys %$res));
|
||||
|
||||
return OK;
|
||||
}
|
||||
|
||||
# Is there a current LJ session?
|
||||
# If so, return info.
|
||||
sub get_user_info
|
||||
{
|
||||
my $POST = shift;
|
||||
BML::reset_cookies();
|
||||
$LJ::_XFER_REMOTE_IP = $POST->{'remote_ip'};
|
||||
|
||||
# try to get a $u from the passed uid or user, falling back to the ljsession cookie
|
||||
my $u;
|
||||
if ($POST->{uid}) {
|
||||
$u = LJ::load_userid($POST->{uid});
|
||||
} elsif ($POST->{user}) {
|
||||
$u = LJ::load_user($POST->{user});
|
||||
} else {
|
||||
$u = LJ::get_remote();
|
||||
}
|
||||
return {} unless $u && $u->{'journaltype'} eq 'P';
|
||||
|
||||
my %ret = (
|
||||
user => $u->{user},
|
||||
userid => $u->{userid},
|
||||
statusvis => $u->{statusvis},
|
||||
can_upload => can_upload($u),
|
||||
gallery_enabled => can_upload($u),
|
||||
diskquota => LJ::get_cap($u, 'disk_quota') * (1 << 20), # mb -> bytes
|
||||
fb_account => LJ::get_cap($u, 'fb_account'),
|
||||
fb_usage => LJ::Blob::get_disk_usage($u, 'fotobilder'),
|
||||
);
|
||||
|
||||
# when the set_quota rpc call is executed (below), a placholder row is inserted
|
||||
# into userblob. it's just used for livejournal display of what we last heard
|
||||
# fotobilder disk usage was, but we need to subtract that out before we report
|
||||
# to fotobilder how much disk the user is using on livejournal's end
|
||||
$ret{diskused} = LJ::Blob::get_disk_usage($u) - $ret{fb_usage};
|
||||
|
||||
return \%ret unless $POST->{fullsync};
|
||||
|
||||
LJ::fill_groups_xmlrpc($u, \%ret);
|
||||
return \%ret;
|
||||
}
|
||||
|
||||
# Forcefully push user info out to FB.
|
||||
# We use this for cases where we don't want to wait for
|
||||
# sync cache timeouts, such as user suspensions.
|
||||
sub push_user_info
|
||||
{
|
||||
my $uid = LJ::want_userid( shift() );
|
||||
return unless $uid;
|
||||
|
||||
my $ret = get_user_info({ uid => $uid });
|
||||
|
||||
eval "use XMLRPC::Lite;";
|
||||
return if $@;
|
||||
|
||||
return XMLRPC::Lite
|
||||
-> proxy("$LJ::FB_SITEROOT/interface/xmlrpc")
|
||||
-> call('FB.XMLRPC.update_userinfo', $ret)
|
||||
-> result;
|
||||
}
|
||||
|
||||
# get_user_info above used to be called 'checksession', maintain
|
||||
# an alias for compatibility
|
||||
sub checksession { get_user_info(@_); }
|
||||
|
||||
sub get_groups {
|
||||
my $POST = shift;
|
||||
my $u = LJ::load_user($POST->{user});
|
||||
return {} unless $u;
|
||||
|
||||
my %ret = ();
|
||||
LJ::fill_groups_xmlrpc($u, \%ret);
|
||||
return \%ret;
|
||||
}
|
||||
|
||||
# Pregenerate a list of challenge/responses.
|
||||
sub makechals
|
||||
{
|
||||
my $POST = shift;
|
||||
my $count = int($POST->{'count'}) || 1;
|
||||
if ($count > 50) { $count = 50; }
|
||||
my $u = LJ::load_user($POST->{'user'});
|
||||
return {} unless $u;
|
||||
|
||||
my %ret = ( count => $count );
|
||||
|
||||
for (my $i=1; $i<=$count; $i++) {
|
||||
my $chal = LJ::rand_chars(40);
|
||||
my $resp = Digest::MD5::md5_hex($chal . Digest::MD5::md5_hex($u->{'password'}));
|
||||
$ret{"chal_$i"} = $chal;
|
||||
$ret{"resp_$i"} = $resp;
|
||||
}
|
||||
|
||||
return \%ret;
|
||||
}
|
||||
|
||||
# Does the user exist?
|
||||
sub user_exists
|
||||
{
|
||||
my $POST = shift;
|
||||
my $u = LJ::load_user($POST->{'user'});
|
||||
return {} unless $u;
|
||||
|
||||
return {
|
||||
exists => 1,
|
||||
can_upload => can_upload($u),
|
||||
};
|
||||
}
|
||||
|
||||
# Mirror FB quota information over to LiveJournal.
|
||||
# 'user' - username
|
||||
# 'used' - FB disk usage in bytes
|
||||
sub set_quota
|
||||
{
|
||||
my $POST = shift;
|
||||
my $u = LJ::load_userid($POST->{'uid'});
|
||||
return {} unless $u && defined $POST->{'used'};
|
||||
|
||||
return {} unless $u->writer;
|
||||
|
||||
my $used = $POST->{'used'} * (1 << 10); # Kb -> bytes
|
||||
my $result = $u->do('REPLACE INTO userblob SET ' .
|
||||
'domain=?, length=?, journalid=?, blobid=0',
|
||||
undef, LJ::get_blob_domainid('fotobilder'),
|
||||
$used, $u->{'userid'});
|
||||
|
||||
LJ::set_userprop($u, "fb_num_pubpics", $POST->{'pub_pics'});
|
||||
|
||||
return {
|
||||
status => ($result ? 1 : 0),
|
||||
};
|
||||
}
|
||||
|
||||
sub get_auth_challenge
|
||||
{
|
||||
my $POST = shift;
|
||||
|
||||
return {
|
||||
chal => LJ::challenge_generate($POST->{goodfor}+0),
|
||||
};
|
||||
}
|
||||
|
||||
#########################################################################
|
||||
# non-interface helper functions
|
||||
#
|
||||
|
||||
# Does the user have upload access?
|
||||
sub can_upload
|
||||
{
|
||||
my $u = shift;
|
||||
|
||||
return LJ::get_cap($u, 'fb_account')
|
||||
&& LJ::get_cap($u, 'fb_can_upload') ? 1 : 0;
|
||||
}
|
||||
|
||||
1;
|
||||
124
livejournal/cgi-bin/Apache/LiveJournal/Interface/S2.pm
Executable file
124
livejournal/cgi-bin/Apache/LiveJournal/Interface/S2.pm
Executable file
@@ -0,0 +1,124 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
package Apache::LiveJournal::Interface::S2;
|
||||
|
||||
use strict;
|
||||
use MIME::Base64 ();
|
||||
use Apache::Constants;
|
||||
|
||||
sub handler {
|
||||
my $r = shift;
|
||||
|
||||
my $meth = $r->method();
|
||||
my %GET = $r->args();
|
||||
my $uri = $r->uri();
|
||||
my $id;
|
||||
if ($uri =~ m!^/interface/s2/(\d+)$!) {
|
||||
$id = $1 + 0;
|
||||
} else {
|
||||
return NOT_FOUND;
|
||||
}
|
||||
|
||||
my $lay = LJ::S2::load_layer($id);
|
||||
return error($r, 404, 'Layer not found', "There is no layer with id $id at this site")
|
||||
unless $lay;
|
||||
|
||||
LJ::auth_digest($r);
|
||||
my $u = LJ::get_remote();
|
||||
unless ($u) {
|
||||
# Tell the client how it can authenticate
|
||||
# use digest authorization.
|
||||
|
||||
$r->send_http_header("text/plain; charset=utf-8");
|
||||
$r->print("Unauthorized\nYou must send your $LJ::SITENAME username and password or a valid session cookie\n");
|
||||
|
||||
return OK;
|
||||
}
|
||||
|
||||
my $dbr = LJ::get_db_reader();
|
||||
|
||||
my $lu = LJ::load_userid($lay->{'userid'});
|
||||
|
||||
return error($r, 500, "Error", "Unable to find layer owner.")
|
||||
unless $lu;
|
||||
|
||||
if ($meth eq 'GET') {
|
||||
|
||||
return error($r, 403, "Forbidden", "You are not authorized to retrieve this layer")
|
||||
unless $lu->{'user'} eq 'system' || LJ::can_manage($u, $lu);
|
||||
|
||||
my $layerinfo = {};
|
||||
LJ::S2::load_layer_info($layerinfo, [ $id ]);
|
||||
my $srcview = exists $layerinfo->{$id}->{'source_viewable'} ?
|
||||
$layerinfo->{$id}->{'source_viewable'} : 1;
|
||||
|
||||
# Disallow retrieval of protected system layers
|
||||
return error($r, 403, "Forbidden", "The requested layer is restricted")
|
||||
if $lu->{'user'} eq 'system' && ! $srcview;
|
||||
|
||||
my $s2code = $dbr->selectrow_array("SELECT s2code FROM s2source WHERE s2lid=?", undef, $id);
|
||||
|
||||
$r->send_http_header("application/x-danga-s2-layer");
|
||||
$r->print($s2code);
|
||||
|
||||
}
|
||||
elsif ($meth eq 'PUT') {
|
||||
|
||||
return error($r, 403, "Forbidden", "You are not authorized to edit this layer")
|
||||
unless LJ::can_manage($u, $lu);
|
||||
|
||||
return error($r, 403, "Forbidden", "Your account type is not allowed to edit layers")
|
||||
unless LJ::get_cap($u, "s2styles");
|
||||
|
||||
# Read in the entity body to get the source
|
||||
my $len = $r->header_in("Content-length")+0;
|
||||
|
||||
return error($r, 400, "Bad Request", "Supply S2 layer code in the request entity body and set Content-length")
|
||||
unless $len;
|
||||
|
||||
return error($r, 415, "Bad Media Type", "Request body must be of type application/x-danga-s2-layer")
|
||||
unless lc($r->header_in("Content-type")) eq 'application/x-danga-s2-layer';
|
||||
|
||||
my $s2code;
|
||||
$r->read($s2code, $len);
|
||||
|
||||
my $error = "";
|
||||
LJ::S2::layer_compile($lay, \$error, { 's2ref' => \$s2code });
|
||||
|
||||
if ($error) {
|
||||
error($r, 500, "Layer Compile Error", "An error was encountered while compiling the layer.");
|
||||
|
||||
## Strip any absolute paths
|
||||
$error =~ s/LJ::.+//s;
|
||||
$error =~ s!, .+?(src/s2|cgi-bin)/!, !g;
|
||||
|
||||
print $error;
|
||||
return OK;
|
||||
}
|
||||
else {
|
||||
$r->status_line("201 Compiled and Saved");
|
||||
$r->header_out("Location" => "$LJ::SITEROOT/interface/s2/$id");
|
||||
$r->send_http_header("text/plain; charset=utf-8");
|
||||
$r->print("Compiled and Saved\nThe layer was uploaded successfully.\n");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Return 'method not allowed' so that we can add methods in future
|
||||
# and clients will get a sensible error from old servers.
|
||||
return error($r, 405, 'Method Not Allowed', 'Only GET and PUT are supported for this resource');
|
||||
}
|
||||
}
|
||||
|
||||
sub error {
|
||||
my ($r, $code, $string, $long) = @_;
|
||||
|
||||
$r->status_line("$code $string");
|
||||
$r->send_http_header("text/plain; charset=utf-8");
|
||||
$r->print("$string\n$long\n");
|
||||
|
||||
# Tell Apache OK so it won't try to handle the error
|
||||
return OK;
|
||||
}
|
||||
|
||||
1;
|
||||
152
livejournal/cgi-bin/Apache/LiveJournal/PalImg.pm
Executable file
152
livejournal/cgi-bin/Apache/LiveJournal/PalImg.pm
Executable file
@@ -0,0 +1,152 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
package Apache::LiveJournal::PalImg;
|
||||
|
||||
use strict;
|
||||
use Apache::Constants qw(:common REDIRECT HTTP_NOT_MODIFIED);
|
||||
use PaletteModify;
|
||||
|
||||
# URLs of form /palimg/somedir/file.gif[extra]
|
||||
# where extras can be:
|
||||
# /p... - palette modify
|
||||
|
||||
sub handler
|
||||
{
|
||||
my $r = shift;
|
||||
my $uri = $r->uri;
|
||||
my ($base, $ext, $extra) = $uri =~ m!^/palimg/(.+)\.(\w+)(.*)$!;
|
||||
$r->notes("codepath" => "img.palimg");
|
||||
return 404 unless $base && $base !~ m!\.\.!;
|
||||
|
||||
my $disk_file = "$LJ::HOME/htdocs/palimg/$base.$ext";
|
||||
return 404 unless -e $disk_file;
|
||||
|
||||
my @st = stat(_);
|
||||
my $size = $st[7];
|
||||
my $modtime = $st[9];
|
||||
my $etag = "$modtime-$size";
|
||||
|
||||
my $mime = {
|
||||
'gif' => 'image/gif',
|
||||
'png' => 'image/png',
|
||||
}->{$ext};
|
||||
|
||||
my $palspec;
|
||||
if ($extra) {
|
||||
if ($extra =~ m!^/p(.+)$!) {
|
||||
$palspec = $1;
|
||||
} else {
|
||||
return 404;
|
||||
}
|
||||
}
|
||||
|
||||
return send_file($r, $disk_file, {
|
||||
'mime' => $mime,
|
||||
'etag' => $etag,
|
||||
'palspec' => $palspec,
|
||||
'size' => $size,
|
||||
'modtime' => $modtime,
|
||||
});
|
||||
}
|
||||
|
||||
sub parse_hex_color
|
||||
{
|
||||
my $color = shift;
|
||||
return [ map { hex(substr($color, $_, 2)) } (0,2,4) ];
|
||||
}
|
||||
|
||||
sub send_file
|
||||
{
|
||||
my ($r, $disk_file, $opts) = @_;
|
||||
|
||||
my $etag = $opts->{'etag'};
|
||||
|
||||
# palette altering
|
||||
my %pal_colors;
|
||||
if (my $pals = $opts->{'palspec'}) {
|
||||
my $hx = "[0-9a-f]";
|
||||
if ($pals =~ /^g($hx{2,2})($hx{6,6})($hx{2,2})($hx{6,6})$/) {
|
||||
# gradient from index $1, color $2, to index $3, color $4
|
||||
my $from = hex($1);
|
||||
my $to = hex($3);
|
||||
return 404 if $from == $to;
|
||||
my $fcolor = parse_hex_color($2);
|
||||
my $tcolor = parse_hex_color($4);
|
||||
if ($to < $from) {
|
||||
($from, $to, $fcolor, $tcolor) =
|
||||
($to, $from, $tcolor, $fcolor);
|
||||
}
|
||||
$etag .= ":pg$pals";
|
||||
for (my $i=$from; $i<=$to; $i++) {
|
||||
$pal_colors{$i} = [ map {
|
||||
int($fcolor->[$_] +
|
||||
($tcolor->[$_] - $fcolor->[$_]) *
|
||||
($i-$from) / ($to-$from))
|
||||
} (0..2) ];
|
||||
}
|
||||
} elsif ($pals =~ /^t($hx{6,6})($hx{6,6})?$/) {
|
||||
# tint everything towards color
|
||||
my ($t, $td) = ($1, $2);
|
||||
$pal_colors{'tint'} = parse_hex_color($t);
|
||||
$pal_colors{'tint_dark'} = $td ? parse_hex_color($td) : [0,0,0];
|
||||
} elsif (length($pals) > 42 || $pals =~ /[^0-9a-f]/) {
|
||||
return 404;
|
||||
} else {
|
||||
my $len = length($pals);
|
||||
return 404 if $len % 7; # must be multiple of 7 chars
|
||||
for (my $i = 0; $i < $len/7; $i++) {
|
||||
my $palindex = hex(substr($pals, $i*7, 1));
|
||||
$pal_colors{$palindex} = [
|
||||
hex(substr($pals, $i*7+1, 2)),
|
||||
hex(substr($pals, $i*7+3, 2)),
|
||||
hex(substr($pals, $i*7+5, 2)),
|
||||
substr($pals, $i*7+1, 6),
|
||||
];
|
||||
}
|
||||
$etag .= ":p$_($pal_colors{$_}->[3])" for (sort keys %pal_colors);
|
||||
}
|
||||
}
|
||||
|
||||
$etag = '"' . $etag . '"';
|
||||
my $ifnonematch = $r->header_in("If-None-Match");
|
||||
return HTTP_NOT_MODIFIED if
|
||||
defined $ifnonematch && $etag eq $ifnonematch;
|
||||
|
||||
# send the file
|
||||
$r->content_type($opts->{'mime'});
|
||||
$r->header_out("Content-length", $opts->{'size'});
|
||||
$r->header_out("ETag", $etag);
|
||||
if ($opts->{'modtime'}) {
|
||||
$r->update_mtime($opts->{'modtime'});
|
||||
$r->set_last_modified();
|
||||
}
|
||||
$r->send_http_header();
|
||||
|
||||
# HEAD request?
|
||||
return OK if $r->method eq "HEAD";
|
||||
|
||||
my $fh = Apache::File->new($disk_file);
|
||||
return 404 unless $fh;
|
||||
binmode($fh);
|
||||
|
||||
my $palette;
|
||||
if (%pal_colors) {
|
||||
if ($opts->{'mime'} eq "image/gif") {
|
||||
$palette = PaletteModify::new_gif_palette($fh, \%pal_colors);
|
||||
} elsif ($opts->{'mime'} == "image/png") {
|
||||
$palette = PaletteModify::new_png_palette($fh, \%pal_colors);
|
||||
}
|
||||
unless ($palette) {
|
||||
return 404; # image isn't palette changeable?
|
||||
}
|
||||
}
|
||||
|
||||
$r->print($palette) if $palette; # when palette modified.
|
||||
$r->send_fd($fh); # sends remaining data (or all of it) quickly
|
||||
$fh->close();
|
||||
return OK;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
Reference in New Issue
Block a user