libperlbal-perl 1.80-3 / usr / share / perl5 / Perlbal / Plugin / Vpaths.pm

This file is indexed.

/usr/share/perl5/Perlbal/Plugin/Vpaths.pm is in libperlbal-perl 1.80-3.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
###########################################################################
# plugin to use with selectors to select by path
#
# this will not play well with the Vhosts plugin or any other selector
# behavior plugins.
#
# this has also not been optimized for huge volume sites.
###########################################################################

package Perlbal::Plugin::Vpaths;

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

our %Services;  # service_name => $svc

# when "LOAD" directive loads us up
sub load {
    my $class = shift;

    Perlbal::register_global_hook('manage_command.vpath', sub {
        my $mc = shift->parse(qr/^vpath\s+(?:(\w+)\s+)?(\S+)\s*=\s*(\w+)$/,
                              "usage: VPATH [<service>] <path regex> = <dest_service>");
        my ($selname, $regex, $target) = $mc->args;
        unless ($selname ||= $mc->{ctx}{last_created}) {
            return $mc->err("omitted service name not implied from context");
        }

        my $ss = Perlbal->service($selname);
        return $mc->err("Service '$selname' is not a selector service")
            unless $ss && $ss->{role} eq "selector";

        my $cregex = qr/$regex/;
        return $mc->err("invalid regular expression: '$regex'")
            unless $cregex;

        $ss->{extra_config}->{_vpaths} ||= [];
        push @{$ss->{extra_config}->{_vpaths}}, [ $cregex, $target ];
  
        return $mc->ok;
    });
    return 1;
}

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

    Perlbal::unregister_global_hook('manage_command.vpath');
    unregister($class, $_) foreach (values %Services);
    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 vpath plugin on a service not of role selector.\n";
    }

    $svc->selector(\&vpath_selector);
    $svc->{extra_config}->{_vpaths} = [];

    $Services{"$svc"} = $svc;
    return 1;
}

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

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

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

    my $uri = $req->request_uri;
    my $maps = $cb->{service}{extra_config}{_vpaths} ||= {};

    # iterate down the list of paths, find any matches
    foreach my $row (@$maps) {
        next unless $uri =~ /$row->[0]/;

        my $svc_name = $row->[1];
        my $svc = $svc_name ? Perlbal->service($svc_name) : undef;
        unless ($svc) {
            $cb->_simple_response(404, "Not Found ($svc_name not a defined service)");
            return 1;
        }

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

    return 0;
}

1;

APT Browse - Built by Thomas Orozco.