###########################################################################
# Plugin to allow acess to different hosts based on URI namespaces.
#
# 2006 - joaop@co.sapo.pt Joao Pedro Goncalves
###########################################################################


package Perlbal::Plugin::AJAXSelector;

use strict;
use warnings;
no  warnings qw(deprecated);

use Socket;
use constant DEBUG => 0;

# Default namespace that triggers the proxy to a different hostname.
# eg: http://perlbal.com/rp/www.perl.com/index.rss
# This namespace is overriden by the configuration directive:
# AJAX NAMESPACE <namespace>

my  $uri_namespace = 'rp';

# Load all the hostnames into Perlbal with pools and services enabled.
sub load {
    my $class = shift;
    print STDERR __PACKAGE__ , " loaded\n\nHostnames Configured:\n" if DEBUG;

    Perlbal::register_global_hook('manage_command.ajax', sub {
        my $mc = shift->parse(qr/^ajax\s+(\w+)\s+(.*?)$/,
                              "usage: AJAX <HOST|NAMESPACE> [<host:port>]");

        my ($service, $h) = $mc->args;

        if(lc($service) eq 'namespace') {
            $uri_namespace = $h;
            return 1;
        }

        my($host, $port) = split(/:/, $h);
        my $pool;
        print STDERR "\t/$uri_namespace/$host\n" if DEBUG;

        # Get the IP Addresses for the host,
        my @ips = gethostbyname($host);
           @ips = map {inet_ntoa($_)} splice(@ips,4); 

        # Use '_' instead of '.' for the configuration directives.
        $host =~ y#\.#_#;

        return unless @ips;
        foreach my $ip (@ips) {
            $ip .= ":$port" if $port;
            print "\t\t$ip\n" if DEBUG;
            $pool .= "POOL p_$host ADD $ip\n";
        }

# Add a pool and service to the configuration.
# 
# TODO: Per service definitions should go on the main configuration.
# 
        Perlbal::run_manage_commands( qq{
           CREATE POOL p_$host
           $pool

           CREATE SERVICE $host
              SET role            = reverse_proxy
              SET pool            = p_$host
              SET persist_client  = on
              SET persist_backend = on
              SET verify_backend  = on
            ENABLE $host
         });
    });
    return 1;
}

# unload our global commands, clear our service object
sub unload {
    my $class = shift;
    return 1;
}

# called when we're being added to a service
sub register {
    my ($class, $svc) = @_;
    unless ($svc && $svc->{role} eq "selector") {
        die "You can't load the vhost plugin on a service not of role selector.\n";
    }

    $svc->selector(\&del_selector);
    return 1;
}

# called when we're no longer active on a service
sub unregister {
    my ($class, $svc) = @_;
    $svc->selector(undef);
    return 1;
}

# call back from Service via ClientHTTPBase's event_read calling 
# service->select_new_service(Perlbal::ClientHTTPBase)
sub del_selector {
    my Perlbal::ClientHTTPBase $cb = shift;

    my $req = $cb->{req_headers};
    return $cb->_simple_response(404, "Not Found (no reqheaders)") unless $req;

    my $vhost = $req->header("Host");
    my $uri  = $req->request_uri;
    my $host;
    my $s;



    # returns 1 if done with client, 0 if no action taken
    my $map_using = sub {
        my ($svc_name) = @_;
        my $svc = Perlbal->service($svc_name);

        unless ($svc) {
            $cb->_simple_response(404, "Not Found (service not configured)");
            return 1;
        }

        $svc->adopt_base_client($cb);
        return 1;
    };

    if($uri =~ s#^/$uri_namespace/(.*?)(/|$)#/#) {
        $host = $1;
        $req->request_uri($uri);
    } else {
        my $ref = $req->header('Referer');
        if($ref && $ref =~ m#^/$uri_namespace/([-.\w]+)(/|$)#) {
            $host = $1;
            print STDERR "REFERER $host selected URI now $uri \n" if DEBUG;
        } else {
            $host = $vhost;
        }
    }


    $req->header('Host' => $host);
    $host =~ y#.#_#;
    return $map_using->($host);
}

1;