2004-05-26 22:46:46 +00:00
|
|
|
# Copyright (C) 2004 Brock Wilcox <awwaiid@thelackthereof.org>
|
|
|
|
|
#
|
|
|
|
|
# This program is free software; you can redistribute it and/or modify
|
|
|
|
|
# it under the terms of the GNU General Public License as published by
|
2016-08-16 14:59:13 +02:00
|
|
|
# the Free Software Foundation; either version 3 of the License, or
|
2004-05-26 22:46:46 +00:00
|
|
|
# (at your option) any later version.
|
|
|
|
|
#
|
|
|
|
|
# This program is distributed in the hope that it will be useful,
|
|
|
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
# GNU General Public License for more details.
|
|
|
|
|
#
|
|
|
|
|
# You should have received a copy of the GNU General Public License
|
2016-08-16 14:59:13 +02:00
|
|
|
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
2004-05-26 22:46:46 +00:00
|
|
|
|
2015-03-27 03:01:01 +02:00
|
|
|
use strict;
|
2015-08-18 10:48:03 +02:00
|
|
|
use v5.10;
|
2004-05-26 22:46:46 +00:00
|
|
|
|
|
|
|
|
use LWP::UserAgent; # This one will one day be eliminated! Hopefully!
|
|
|
|
|
|
|
|
|
|
# Need these to do pingback
|
|
|
|
|
use RPC::XML;
|
|
|
|
|
use RPC::XML::Parser;
|
|
|
|
|
|
2015-04-04 23:12:55 +03:00
|
|
|
AddModuleDescription('pingback-server.pl', 'Pingback Server Extension');
|
2015-03-27 03:01:01 +02:00
|
|
|
|
2015-04-10 13:31:28 +03:00
|
|
|
our ($CommentsPrefix);
|
2004-05-26 22:46:46 +00:00
|
|
|
|
2015-04-11 23:41:33 +03:00
|
|
|
*OldPingbackServerGetHtmlHeader = \&GetHtmlHeader;
|
|
|
|
|
*GetHtmlHeader = \&NewPingbackServerGetHtmlHeader;
|
2004-05-26 22:46:46 +00:00
|
|
|
|
|
|
|
|
# Add the <link ...> to the header
|
|
|
|
|
sub NewPingbackServerGetHtmlHeader {
|
|
|
|
|
my ($title, $id) = @_;
|
|
|
|
|
my $header = OldPingbackServerGetHtmlHeader($title,$id);
|
|
|
|
|
my $pingbackLink =
|
|
|
|
|
'<link rel="pingback" '
|
|
|
|
|
. 'href="http://thelackthereof.org/wiki.pl?action=pingback;id='
|
|
|
|
|
. $id . '">';
|
|
|
|
|
$header =~ s/<head>/<head>$pingbackLink/;
|
|
|
|
|
return $header;
|
|
|
|
|
}
|
|
|
|
|
|
2015-04-11 23:41:33 +03:00
|
|
|
*OldPingbackServerInitRequest = \&InitRequest;
|
|
|
|
|
*InitRequest = \&NewPingbackServerInitRequest;
|
2004-05-26 22:46:46 +00:00
|
|
|
|
|
|
|
|
sub NewPingbackServerInitRequest {
|
|
|
|
|
if($ENV{'QUERY_STRING'} =~ /action=pingback;id=(.*)/) {
|
|
|
|
|
my $id = $1;
|
|
|
|
|
DoPingbackServer($id);
|
|
|
|
|
exit 0;
|
|
|
|
|
} else {
|
|
|
|
|
return OldPingbackServerInitRequest(@_);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub DoPingbackServer {
|
|
|
|
|
my $id = FreeToNormal(shift);
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if ($ENV{'REQUEST_METHOD'} ne 'POST') {
|
|
|
|
|
result('405 Method Not Allowed', -32300,
|
|
|
|
|
'Only XML-RPC POST requests recognised.', 'Allow: POST');
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
if ($ENV{'CONTENT_TYPE'} ne 'text/xml') {
|
|
|
|
|
result('415 Unsupported Media Type', -32300,
|
|
|
|
|
'Only XML-RPC POST requests recognised.');
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
local $/ = undef;
|
|
|
|
|
my $input = <STDIN>;
|
|
|
|
|
|
|
|
|
|
# parse it
|
|
|
|
|
my $parser = RPC::XML::Parser->new();
|
|
|
|
|
my $request = $parser->parse($input);
|
|
|
|
|
if (not ref($request)) {
|
|
|
|
|
result('400 Bad Request', -32700, $request);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# handle it
|
|
|
|
|
my $name = $request->name;
|
|
|
|
|
my $arguments = $request->args;
|
|
|
|
|
if ($name ne 'pingback.ping') {
|
|
|
|
|
result('501 Not Implemented', -32601, "Method $name not supported");
|
|
|
|
|
}
|
|
|
|
|
if (@$arguments != 2) {
|
|
|
|
|
result('400 Bad Request', -32602,
|
|
|
|
|
"Wrong number of arguments (arguments must be in the form 'from', 'to')");
|
|
|
|
|
}
|
|
|
|
|
my $source = $arguments->[0]->value;
|
|
|
|
|
my $target = $arguments->[1]->value;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
# TODO: Since we are _inside_ the wiki seems like we shouldn't have to use LWP
|
|
|
|
|
# So comment out all the LWP stuff once the DoPost thingie works
|
|
|
|
|
# DoPost($id);
|
|
|
|
|
|
|
|
|
|
my $ua = LWP::UserAgent->new;
|
|
|
|
|
$ua->agent("OddmusePingbackServer/0.1 ");
|
|
|
|
|
|
|
|
|
|
# Create a request
|
|
|
|
|
my $req = HTTP::Request->new(POST => 'http://thelackthereof.org/wiki.pl');
|
|
|
|
|
$req->content_type('application/x-www-form-urlencoded');
|
|
|
|
|
$req->content("title=$CommentsPrefix$id"
|
|
|
|
|
. "&summary=new%20comment"
|
|
|
|
|
. "&aftertext=Pingback:%20$source"
|
|
|
|
|
. "&save=save"
|
|
|
|
|
. "&username=pingback");
|
|
|
|
|
my $res = $ua->request($req);
|
|
|
|
|
|
|
|
|
|
my $out = '';
|
|
|
|
|
# Check the outcome of the response
|
|
|
|
|
if ($res->is_success) {
|
|
|
|
|
$out = $res->content;
|
|
|
|
|
} else {
|
2015-04-28 00:03:11 +03:00
|
|
|
$out = $res->status_line . "\n";
|
2004-05-26 22:46:46 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
result('200 OK', 0, "Oddmuse PingbackServer! $id OK");
|
2015-05-02 03:56:04 +03:00
|
|
|
}
|
2004-05-26 22:46:46 +00:00
|
|
|
|
2015-05-02 03:56:04 +03:00
|
|
|
sub result {
|
|
|
|
|
my($status, $error, $data, $extra) = @_;
|
|
|
|
|
my $response;
|
|
|
|
|
if ($error) {
|
|
|
|
|
$response = RPC::XML::response->new(
|
|
|
|
|
RPC::XML::fault->new($error, $data));
|
|
|
|
|
} else {
|
|
|
|
|
$response = RPC::XML::response->new(RPC::XML::string->new($data));
|
|
|
|
|
}
|
|
|
|
|
print "Status: $status\n";
|
|
|
|
|
if (defined($extra)) {
|
|
|
|
|
print "$extra\n";
|
2004-05-26 22:46:46 +00:00
|
|
|
}
|
2015-05-02 03:56:04 +03:00
|
|
|
print "Content-Type: text/xml\n\n";
|
|
|
|
|
print $response->as_string;
|
|
|
|
|
exit;
|
|
|
|
|
}
|
2004-05-26 22:46:46 +00:00
|
|
|
|
|
|
|
|
=pod
|
2015-03-27 03:01:01 +02:00
|
|
|
|
2004-05-26 22:46:46 +00:00
|
|
|
# This doesn't work... but might be a basis for an in-wiki update system
|
|
|
|
|
|
|
|
|
|
sub DoPost {
|
|
|
|
|
my $id = FreeToNormal(shift);
|
|
|
|
|
my $source = shift;
|
|
|
|
|
ValidIdOrDie($id);
|
|
|
|
|
# Lock before getting old page to prevent races
|
|
|
|
|
RequestLockOrError(); # fatal
|
|
|
|
|
OpenPage($id);
|
|
|
|
|
my $string = $Page{text};
|
|
|
|
|
my $comment = "Pingback: $source";
|
|
|
|
|
$comment =~ s/\r//g; # Remove "\r"-s (0x0d) from the string
|
|
|
|
|
$comment =~ s/\s+$//g; # Remove whitespace at the end
|
|
|
|
|
$string .= "----\n" if $string and $string ne "\n";
|
|
|
|
|
$string .= $comment . "\n\n-- Pingback"
|
|
|
|
|
. ' ' . TimeToText(time) . "\n\n";
|
|
|
|
|
my $summary = "new pingback"
|
|
|
|
|
$Page{summary} = $summary;
|
|
|
|
|
$Page{username} = $user;
|
|
|
|
|
$Page{text} = $string;
|
|
|
|
|
SavePage();
|
|
|
|
|
ReleaseLock();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
=cut
|
