added pingback capabilities
git-svn-id: http://yolanda.mister-muffin.de/svn@314 7eef14d0-6ed0-489d-bf55-20463b2d70db
This commit is contained in:
parent
0a27a8c730
commit
bc77df2335
7 changed files with 227 additions and 8 deletions
|
@ -15,8 +15,8 @@ NameVirtualHost *
|
|||
AllowEncodedSlashes On
|
||||
|
||||
RewriteEngine On
|
||||
RewriteRule ^/video/(.*)/([0-9]*)/(.*)$ /video.pl?title=$1&id=$2&$3
|
||||
RewriteRule ^/embedded/(.*)/([0-9]*)/(.*)$ /video.pl?title=$1&id=$2&embed=true&$3
|
||||
RewriteRule ^/video/(.*)/([0-9]+)/(.*)$ /video.pl?title=$1&id=$2&$3
|
||||
RewriteRule ^/embedded/(.*)/([0-9]+)/(.*)$ /video.pl?title=$1&id=$2&embed=true&$3
|
||||
RewriteRule ^/download/([0-9]+)/(.*)$ /download.pl?id=$1&$2
|
||||
|
||||
ErrorLog /var/log/apache2/error.log
|
||||
|
|
|
@ -235,9 +235,6 @@ sub urlencode
|
|||
|
||||
sub output_page
|
||||
{
|
||||
use XML::LibXSLT;
|
||||
use XML::LibXML;
|
||||
|
||||
my $parser = XML::LibXML->new();
|
||||
my $xslt = XML::LibXSLT->new();
|
||||
|
||||
|
@ -303,6 +300,7 @@ sub output_page
|
|||
return $session->header(
|
||||
-type=>$stylesheet->media_type,
|
||||
-charset=>$stylesheet->output_encoding,
|
||||
"x-pingback"=>$config->{"url_root"}."/pingback.pl"
|
||||
),
|
||||
$output->toString;
|
||||
#$stylesheet->output_as_bytes($output); <= for future use with XML::LibXSLT (>= 1.62)
|
||||
|
|
|
@ -7,8 +7,12 @@ use XML::Simple qw(:strict);
|
|||
use Digest::SHA qw(sha256_hex);
|
||||
use LWPx::ParanoidAgent;
|
||||
use Net::OpenID::Consumer;
|
||||
use CGI::Carp qw(fatalsToBrowser set_message);
|
||||
use File::Copy;
|
||||
use XML::LibXSLT;
|
||||
use XML::LibXML;
|
||||
use LWP::UserAgent;
|
||||
use HTTP::Request;
|
||||
use CGI::Carp qw(fatalsToBrowser set_message);
|
||||
|
||||
set_message("It's not a bug, it's a feature!!<br />(include this error message in your bugreport here: <a href=\"http://yolanda.mister-muffin.de/newticket\">Yolanda bugtracker</a>)");
|
||||
|
||||
|
|
|
@ -117,7 +117,19 @@ $dbh->do(qq{create table
|
|||
id int auto_increment not null,
|
||||
userid int not null,
|
||||
videoid int not null,
|
||||
text varchar(255) not null,
|
||||
text text not null,
|
||||
timestamp bigint not null,
|
||||
primary key (id)
|
||||
)
|
||||
}) or die $dbh->errstr;
|
||||
|
||||
$dbh->do(qq{create table
|
||||
pingbacks
|
||||
(
|
||||
id int auto_increment not null,
|
||||
source varchar(255) not null,
|
||||
videoid int not null,
|
||||
text text not null,
|
||||
timestamp bigint not null,
|
||||
primary key (id)
|
||||
)
|
||||
|
|
137
trunk/pingback.pl
Normal file
137
trunk/pingback.pl
Normal file
|
@ -0,0 +1,137 @@
|
|||
require "functions.pl";
|
||||
|
||||
#initialize session data
|
||||
CGI::Session->name($config->{"page_cookie_name"});
|
||||
$query = new CGI;
|
||||
$session = new CGI::Session;
|
||||
|
||||
if ($query->param("POSTDATA"))
|
||||
{
|
||||
my $xmlpost = XMLin($query->param("POSTDATA"), ForceArray => 0, KeyAttr => 0);
|
||||
|
||||
if (!$@)
|
||||
{
|
||||
my $method = $xmlpost->{"methodName"};
|
||||
my $source = $xmlpost->{"params"}->{"param"}[0]->{"value"}->{"string"};
|
||||
my $target = $xmlpost->{"params"}->{"param"}[1]->{"value"}->{"string"};
|
||||
|
||||
if ($method eq "pingback.ping")
|
||||
{
|
||||
if ($source =~ /^http:\/\// and $target =~ /^http:\/\//)
|
||||
{
|
||||
#fetch the source URI to verify that the source does indeed link to the target.
|
||||
my $request = HTTP::Request->new(GET => $source);
|
||||
my $ua = LWP::UserAgent->new;
|
||||
my $response = $ua->request($request);
|
||||
|
||||
if ($response->is_success)
|
||||
{
|
||||
#TODO: sanitize regex to grep site content
|
||||
if (my ($text) = $response->content =~ m/(\S*.{0,17}$target.{0,17}\S*)/)
|
||||
{
|
||||
#check data to ensure that the target exists and is a valid entry.
|
||||
my ($vid) = $target =~ /^$config->{'url_root'}\/video\/.*\/(\d+)\/.*/;
|
||||
|
||||
my $sth = $dbh->prepare("select id from videos where id = ? limit 1");
|
||||
my $rowcount = $sth->execute($vid) or die $dbh->errstr;
|
||||
|
||||
$sth->finish() or die $dbh->errstr;
|
||||
|
||||
if ($rowcount)
|
||||
{
|
||||
#check that the pingback has not already been registered.
|
||||
$sth = $dbh->prepare("select id from pingbacks where videoid = ? limit 1");
|
||||
$rowcount = $sth->execute($vid) or die $dbh->errstr;
|
||||
$sth->finish() or die $dbh->errstr;
|
||||
|
||||
if ($rowcount eq "0E0")
|
||||
{
|
||||
#record the pingback.
|
||||
$dbh->do(qq{insert into pingbacks (source, videoid, text, timestamp) values (?, ?, ?, unix_timestamp())}, undef,
|
||||
$source, $vid, $text) or die $dbh->errstr;
|
||||
|
||||
my $xml = ();
|
||||
$xml->{'params'}->{'param'}->{'value'}->{'string'} = ["Pingback from $source to $target registered. Keep the web talking! :-)"];
|
||||
|
||||
print $session->header(
|
||||
-type=>'application/xml',
|
||||
-charset=>'UTF-8',
|
||||
);
|
||||
|
||||
print XMLout(
|
||||
$xml,
|
||||
XMLDecl => 1,
|
||||
KeyAttr => {},
|
||||
RootName => 'methodResponse'
|
||||
);
|
||||
}
|
||||
else
|
||||
{
|
||||
send_error(48, "The pingback has already been registered.");
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
send_error(33, "The specified target URI cannot be used as a target.");
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
send_error(17, "The source URI does not contain a link to the target URI, and so cannot be used as a source.");
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
send_error(16, "The source URI does not exist.");
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
send_error(-32602, "server error. invalid method parameters");
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
send_error(-32601, "server error. requested method not found");
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
send_error(-32700,"parse error. not well formed");
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
print $session->header;
|
||||
print "XML-RPC server only accepts POST requests with http content-type defined.";
|
||||
}
|
||||
|
||||
sub send_error
|
||||
{
|
||||
my ($faultCode, $faultString) = @_;
|
||||
|
||||
my $xml = ();
|
||||
push @{$xml->{'fault'}->{'value'}->{'struct'}->{'member'}},
|
||||
{
|
||||
"name" => ["faultCode"],
|
||||
"value" => [$faultCode]
|
||||
};
|
||||
push @{$xml->{'fault'}->{'value'}->{'struct'}->{'member'}},
|
||||
{
|
||||
"name" => ["faultString"],
|
||||
"value" => [$faultString]
|
||||
};
|
||||
|
||||
print $session->header(
|
||||
-type=>'application/xml',
|
||||
-charset=>'UTF-8',
|
||||
);
|
||||
|
||||
print XMLout(
|
||||
$xml,
|
||||
XMLDecl => 1,
|
||||
KeyAttr => {},
|
||||
RootName => 'methodResponse'
|
||||
);
|
||||
}
|
||||
|
|
@ -76,10 +76,75 @@ if($query->url_param('id'))
|
|||
#output infobox
|
||||
$page->{'message'}->{'type'} = "information";
|
||||
$page->{'message'}->{'text'} = "information_comment_created";
|
||||
|
||||
|
||||
#add to database
|
||||
$dbh->do(qq{insert into comments (userid, videoid, text, timestamp) values (?, ?, ?, unix_timestamp())}, undef,
|
||||
$userinfo->{'id'}, $id, $query->param('comment')) or die $dbh->errstr;
|
||||
|
||||
#send pingbacks to every url in the comment
|
||||
my (@matches) = $query->param('comment') =~ /(http:\/\/\S+)/gi;
|
||||
foreach $match (@matches)
|
||||
{
|
||||
#ask for http header only - if pingbacks are implemented right, then we wont need the full site
|
||||
my $request = HTTP::Request->new(HEAD => $match);
|
||||
my $ua = LWP::UserAgent->new;
|
||||
|
||||
my $response = $ua->request($request);
|
||||
|
||||
if ($response->is_success)
|
||||
{
|
||||
my $pingbackurl = $response->header("x-pingback");
|
||||
|
||||
#if there was no x-pingback header, fetch the website and search for link element
|
||||
if (!$pingbackurl)
|
||||
{
|
||||
$request = HTTP::Request->new(GET => $match);
|
||||
$response = $ua->request($request);
|
||||
|
||||
if ($response->is_success)
|
||||
{
|
||||
($pingbackurl) = $response->content =~ /<link rel="pingback" href="([^"]+)" ?\/?>/;
|
||||
}
|
||||
}
|
||||
|
||||
#if requests were successful, send the pingbacks
|
||||
if ($pingbackurl)
|
||||
{
|
||||
#TODO: expand xml entities < > & " in $pingbackurl
|
||||
|
||||
#contruct the xml-rpc request
|
||||
my $xmlpost->{"methodName"} = ["pingback.ping"];
|
||||
push @{$xmlpost->{'params'}->{'param'} },
|
||||
{
|
||||
"value" =>
|
||||
{
|
||||
"string" => [$config->{"url_root"}."/video/".urlencode($title)."/$id/"]
|
||||
}
|
||||
};
|
||||
push @{$xmlpost->{'params'}->{'param'} },
|
||||
{
|
||||
"value" =>
|
||||
{
|
||||
"string" => [$match]
|
||||
}
|
||||
};
|
||||
|
||||
#post a xml-rpc request
|
||||
$request = HTTP::Request->new(POST => $pingbackurl);
|
||||
$request->header('Content-Type' => "application/xml");
|
||||
$request->content(XMLout(
|
||||
$xmlpost,
|
||||
XMLDecl => 1,
|
||||
KeyAttr => {},
|
||||
RootName => 'methodCall'
|
||||
));
|
||||
$ua = LWP::UserAgent->new;
|
||||
$response = $ua->request($request);
|
||||
print $response->content;
|
||||
#TODO: maybe do something on success?
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
@ -39,6 +39,9 @@
|
|||
<xsl:value-of select="$site_strings[@id='site_name']" />
|
||||
</xsl:attribute>
|
||||
</link>
|
||||
|
||||
<!-- TODO: get server root from config file-->
|
||||
<link rel="pingback" href="http://localhost/pingback.pl" />
|
||||
|
||||
<xsl:choose>
|
||||
<xsl:when test="//frontpage">
|
||||
|
|
Loading…
Reference in a new issue