###################################################################### # Management connection from a client ###################################################################### package Perlbal::ClientManage; use strict; use warnings; no warnings qw(deprecated); use base "Perlbal::Socket"; use fields ('service', 'buf', 'is_http', # bool: is an HTTP request? 'ctx', # command context ); # ClientManage sub new { my Perlbal::ClientManage $self = shift; my ($service, $sock) = @_; $self = fields::new($self) unless ref $self; $self->SUPER::new($sock); $self->{service} = $service; $self->{buf} = ""; # what we've read so far, not forming a complete line $self->{ctx} = Perlbal::CommandContext->new; $self->{ctx}->verbose(1); $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; if ($line =~ /^quit|exit$/) { $self->close('user_requested_quit'); return; } my $out = sub { $self->write("$_[0]\r\n"); }; Perlbal::run_manage_command($line, $out, $self->{ctx}); } } sub event_write { my $self = shift; $self->watch_write(0) if $self->write(undef); } # 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 .= "
$cmd
"; Perlbal::run_manage_command($cmd, sub { my $line = $_[0] || ""; $alt->(\$line) if $alt; $body .= "$line\n"; }); $body .= "
\n"; }; $body .= "\n"; $body .= "\n"; $body .= "perlbal management interface"; if ($uri eq "/") { $body .= "

perlbal management interface

"; } elsif ($uri eq "/socks") { $prebox->('socks summary'); $prebox->('socks', sub { ${$_[0]} =~ s!service \'(\w+)\'!$1!; }); } elsif ($uri eq "/obj") { $prebox->('obj'); } elsif ($uri =~ m!^/service\?(\w+)$!) { my $service = $1; $prebox->("show service $service"); } else { $code = "404 Not found"; $body .= "

$code

"; } $body .= "

Perlbal management.

\n"; $self->write("HTTP/1.0 $code\r\nContent-type: text/html\r\nContent-Length: " . length($body) . "\r\n\r\n$body"); $self->write(sub { $self->close; }); return; } 1; # Local Variables: # mode: perl # c-basic-indent: 4 # indent-tabs-mode: nil # End: