|
Revision 431, 1.4 kB
(checked in by bradfitz, 4 years ago)
|
|
start of work on access control plugin. doesn't work (or even
compile) yet, but I wanted to get it in so I could hack on it
elsewhere, and it doesn't break anything else, being just a plugin.
|
-
Property svn:eol-style set to
native
-
Property svn:keywords set to
Author Date Id Revision
|
| Line | |
|---|
| 1 | package Perlbal::Plugin::AtomInject; |
|---|
| 2 | |
|---|
| 3 | use Perlbal; |
|---|
| 4 | use strict; |
|---|
| 5 | use warnings; |
|---|
| 6 | |
|---|
| 7 | our @subs; # subscribers |
|---|
| 8 | |
|---|
| 9 | # called when we're being added to a service |
|---|
| 10 | sub register { |
|---|
| 11 | my ($class, $svc) = @_; |
|---|
| 12 | |
|---|
| 13 | $svc->{enable_put} = 1; |
|---|
| 14 | |
|---|
| 15 | $svc->register_hook('AtomInject', 'handle_put', sub { |
|---|
| 16 | my Perlbal::ClientHTTP $self = shift; |
|---|
| 17 | my Perlbal::HTTPHeaders $hds = $self->{req_headers}; |
|---|
| 18 | return 0 unless $hds; |
|---|
| 19 | |
|---|
| 20 | return $self->send_response(400, "Invalid method") |
|---|
| 21 | unless $hds->request_method eq "PUT"; |
|---|
| 22 | |
|---|
| 23 | my $uri = $hds->request_uri; |
|---|
| 24 | return $self->send_response(400, "Invalid uri") unless $uri eq "/"; |
|---|
| 25 | |
|---|
| 26 | # now abort the normal handle_put processing... |
|---|
| 27 | return 1; |
|---|
| 28 | }); |
|---|
| 29 | |
|---|
| 30 | $svc->register_hook('AtomInject', 'put_writeout', sub { |
|---|
| 31 | my Perlbal::ClientHTTP $self = shift; |
|---|
| 32 | return 1 if $self->{content_length_remain}; |
|---|
| 33 | |
|---|
| 34 | my $data = join("", map { $$_ } @{$self->{read_buf}}); |
|---|
| 35 | |
|---|
| 36 | # reset our input buffer |
|---|
| 37 | $self->{read_buf} = []; |
|---|
| 38 | $self->{read_ahead} = 0; |
|---|
| 39 | |
|---|
| 40 | my $rv = eval { Perlbal::Plugin::AtomStream->InjectFeed(\$data); }; |
|---|
| 41 | return $self->send_response(200); |
|---|
| 42 | }); |
|---|
| 43 | |
|---|
| 44 | return 1; |
|---|
| 45 | } |
|---|
| 46 | |
|---|
| 47 | # called when we're no longer active on a service |
|---|
| 48 | sub unregister { |
|---|
| 49 | my ($class, $svc) = @_; |
|---|
| 50 | return 1; |
|---|
| 51 | } |
|---|
| 52 | |
|---|
| 53 | # called when we are loaded |
|---|
| 54 | sub load { |
|---|
| 55 | return 1; |
|---|
| 56 | } |
|---|
| 57 | |
|---|
| 58 | # called for a global unload |
|---|
| 59 | sub unload { |
|---|
| 60 | return 1; |
|---|
| 61 | } |
|---|
| 62 | |
|---|
| 63 | |
|---|
| 64 | 1; |
|---|