pubsubhubbub-reverse-http.pl

#!/usr/bin/perl
use strict;
use LWP::UserAgent;

my $url = "http://www.reversehttp.net/reversehttp";
my $label = int rand 100000;

warn "Open http://demo$label.www.reversehttp.net/\n";

my $ua = LWP::UserAgent->new;
my $res = $ua->post($url, { name => "demo$label", token => "-" });

start_receive($res);

sub start_receive {
    my($res, $next) = @_;

    my @links = grep /^<.*?>;.*\brel="(first|next)"/, $res->header('Link');
    if (@links && $links[0] =~ /^<(.*?)>/) {
        $next = $1;
    }

    $res = $ua->get($next);
    my $req = HTTP::Request->parse($res->content);
    my $send_res = serve_request($req);

    if ($send_res) {
        my $raw = $send_res->as_string;
        chomp $raw; # Ugh
        my $req = HTTP::Request->new(POST => $next);
        $req->content_type('message/http');
        $req->content($raw);
        $res = $ua->request($req);
    }

    start_receive($res, $next);
}

sub serve_request {
    my $req = shift;

    return unless $req->uri; # reconnect
    use Data::Dumper;
    warn Dumper $req;

    my $res = HTTP::Response->new(200);
    $res->protocol("HTTP/1.1");
    $res->content_type('text/plain');

    my($token) = $req->uri =~ /hub\.challenge=(.*?)&/;
    if ($token) {
        $res->content($token);
    } else {
        $res->content("OK");
    }

    return $res;
}