#!/usr/bin/perl -wT
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
#
# Pingback Proxy: Trackback HTTP GET to Pingback XML-RPC POST
#
# Copyright (c) 2002 by Ian Hickson
#
# 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
# the Free Software Foundation; either version 2 of the License, or
# (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
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

use strict;
use diagnostics;
use lib '/home/ianh/lib/perl';
use CGI;
use RPC::XML;
use RPC::XML::Client;
use HTML::Entities;
use URI::Escape;

print STDERR "\ntrackback-to-pingback proxy invoked\n";

if (not defined($ENV{'PATH_INFO'}) or $ENV{'PATH_INFO'} !~ m|/|os) {
    result('400 Bad Request', 'Configuration Error: Missing server and target URIs (see README).');
}

# get arguments
my $target = $ENV{'PATH_INFO'}; # Apache does this level of unescaping: uri_unescape($ENV{'PATH_INFO'});
$target =~ s|^/([^,]+),||os;
my $server = uri_unescape($1);
$target = uri_unescape($target);
my $query = CGI->new();
my $title = $query->param('title');
my $excerpt = $query->param('excerpt');
my $source = $query->param('url');
my $blog_name = $query->param('blog_name');
if (not defined($source) or not defined($target)) {
    result('400 Bad Request', 'Client Error: You must pass both source and target parameters.');
}

print STDERR "source=$source\ntarget=$target\nserver=$server\n";

# ok, try to contact the server
my $response = RPC::XML::Client->new($server)->send_request('pingback.ping', $source, $target);
if (not ref($response)) {
    result('502 Bad Gateway', 'Server Error: ' . $response);
}

print STDERR "response=\n" . ($response->as_string) . "\n";

if ($response->is_fault) {
    result('502 Fault', 'Server Error: ' . $response->string);
}
result('202 Accepted');


sub result {
    my($status, $message) = @_;
    my $data;
    if (defined($message)) {
        print STDERR "status=$status\nmessage=$message\n\n";
        $data = <<EOF;
<?xml version="1.0" encoding="iso-8859-1"?>
<response>
<error>1</error>
<message>$message</message>
</response>
EOF
    } else {
        print STDERR "status=$status\n\n";
        $data = <<EOF;
<?xml version="1.0" encoding="iso-8859-1"?>
<response>
<error>0</error>
</response>
EOF
    }
    my $length = length($data);
    print <<EOF;
Status: $status
Content-Type: text/xml
Content-Length: $length

$data
EOF
    exit;
}