###################################################################### # Management connection from a client ###################################################################### package Perlbal::ClientManage; use strict; use warnings; use base "Perlbal::Socket"; use fields ('service', 'buf', 'is_http', # bool: is an HTTP request? 'verbose', # bool: on/off if we should be verbose for management commands ); # ClientManage sub new { my ($class, $service, $sock) = @_; my $self = $class->SUPER::new($sock); $self->{service} = $service; $self->{buf} = ""; # what we've read so far, not forming a complete line $self->{verbose} = 1; bless $self, ref $class || $class; $self->watch_read(1); return $self; } # ClientManage sub event_read { my Perlbal::ClientManage $self = shift; my $bref; unless ($self->{is_http}) { $bref = $self->read(1024); return $self->close() unless defined $bref; $self->{buf} .= $$bref; if ($self->{buf} =~ /^(?:HEAD|GET|POST) /) { $self->{is_http} = 1; $self->{headers_string} .= $$bref; } } if ($self->{is_http}) { my $hd = $self->read_request_headers; return unless $hd; $self->handle_http(); return; } while ($self->{buf} =~ s/^(.+?)\r?\n//) { my $line = $1; # enable user to turn verbose on and off for our connection if ($line =~ /^verbose (on|off)$/i) { $self->{verbose} = (lc $1 eq 'on' ? 1 : 0); $self->write("OK\r\n") if $self->{verbose}; next; } if ($line =~ /^quit/) { $self->close('user_requested_quit'); return; } Perlbal::run_manage_command($line, sub { $self->write(join("\r\n", map { ref $_ eq 'ARRAY' ? @$_ : $_ } @_) . "\r\n"); }, $self->{verbose}); } } # ClientManage sub event_err { my $self = shift; $self->close; } sub event_hup { my $self = shift; $self->close; } # HTTP management support sub handle_http { my Perlbal::ClientManage $self = shift; my $uri = $self->{req_headers}->request_uri; my $body; my $code = "200 OK"; my $prebox = sub { my $cmd = shift; my $alt = shift; $body .= "
\n"; }; if ($uri eq "/") { $body .= "$cmd"; Perlbal::run_manage_command($cmd, sub { my $line = $_[0] || ""; $alt->(\$line) if $alt; $body .= "$line\n"; }); $body .= "