From 6cce2b9dba5abf05ff7f76b22ef94bb3603be701 Mon Sep 17 00:00:00 2001 From: bradfitz Date: Tue, 26 Jul 2005 05:11:07 +0000 Subject: [PATCH] -- introduce CommandContext, so management commands can be less verbose when in config files (service/pool names can be left off when you just created them a couple lines before) git-svn-id: http://code.sixapart.com/svn/perlbal/trunk@341 6caf28e9-730f-0410-b62b-a31386fe13fb --- CHANGES | 4 ++++ conf/webserver.conf | 10 +++++----- lib/Perlbal.pm | 23 +++++++++++++++++------ lib/Perlbal/CommandContext.pm | 23 +++++++++++++++++++++++ lib/Perlbal/ManageCommand.pm | 20 +++++++++++++------- lib/Perlbal/Plugin/Vhosts.pm | 7 +++++-- 6 files changed, 67 insertions(+), 20 deletions(-) create mode 100644 lib/Perlbal/CommandContext.pm diff --git a/CHANGES b/CHANGES index 2a899e2..00ce1a7 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,7 @@ + -- introduce CommandContext, so management commands can be less + verbose when in config files (service/pool names can be left off + when you just created them a couple lines before) + -- remove sendstats support -- exit with 0 vs non-zero when/if Perlbal crashes. new command diff --git a/conf/webserver.conf b/conf/webserver.conf index 6cd2843..a0f2be1 100644 --- a/conf/webserver.conf +++ b/conf/webserver.conf @@ -6,9 +6,9 @@ # CREATE SERVICE docs - SET docs.listen = 0.0.0.0:80 - SET docs.role = web_server - SET docs.docroot = /usr/share/doc/ - SET docs.dirindexing = 1 - SET docs.persist_client = on + SET listen = 0.0.0.0:80 + SET role = web_server + SET docroot = /usr/share/doc/ + SET dirindexing = 1 + SET persist_client = on ENABLE docs diff --git a/lib/Perlbal.pm b/lib/Perlbal.pm index 94039ca..67e0039 100644 --- a/lib/Perlbal.pm +++ b/lib/Perlbal.pm @@ -44,6 +44,7 @@ use Perlbal::BackendHTTP; use Perlbal::ReproxyManager; use Perlbal::Pool; use Perlbal::ManageCommand; +use Perlbal::CommandContext; END { Linux::AIO::max_parallel(0) @@ -162,7 +163,7 @@ sub pool { # returns 1 if command succeeded, 0 otherwise sub run_manage_command { - my ($cmd, $out, $verbose) = @_; # $out is output stream closure + my ($cmd, $out, $verbose, $ctx) = @_; # $out is output stream closure $cmd =~ s/\#.*//; $cmd =~ s/^\s+//; @@ -174,6 +175,7 @@ sub run_manage_command { return 1 unless $cmd =~ /^\S/; $out ||= sub {}; + $ctx ||= Perlbal::CommandContext->new; my $err = sub { $out->("ERROR: $_[0]"); @@ -187,7 +189,7 @@ sub run_manage_command { return $err->("invalid command") unless $cmd =~ /^(\w+)/; my $basecmd = $1; - my $mc = Perlbal::ManageCommand->new($basecmd, $cmd, $out, $ok, $err, $orig, $verbose); + my $mc = Perlbal::ManageCommand->new($basecmd, $cmd, $out, $ok, $err, $orig, $verbose, $ctx); # for testing auto crashing and recovery: if ($basecmd eq "crash") { die "Intentional crash." }; @@ -195,7 +197,7 @@ sub run_manage_command { no strict 'refs'; if (my $handler = *{"MANAGE_$basecmd"}{CODE}) { my $rv = eval { $handler->($mc); }; - return $err->($@) if $@; + return $mc->err($@) if $@; return $rv; } @@ -203,6 +205,7 @@ sub run_manage_command { # call any hooks if they've been defined my $rval = eval { run_global_hook("manage_command.$basecmd", $mc); }; + return $mc->err($@) if $@; if (defined $rval) { # commands may return boolean, or arrayref to mass-print if (ref $rval eq "ARRAY") { @@ -212,7 +215,7 @@ sub run_manage_command { return $rval; } - return $err->("unknown command: $basecmd"); + return $mc->err("unknown command: $basecmd"); } sub MANAGE_obj { @@ -745,6 +748,7 @@ sub MANAGE_create { return $mc->err("service '$name' already exists") if $service{$name}; return $mc->err("pool '$name' already exists") if $pool{$name}; $service{$name} = Perlbal::Service->new($name); + $mc->{ctx}{last_created} = $name; return $mc->ok; } @@ -753,6 +757,7 @@ sub MANAGE_create { return $mc->err("service '$name' already exists") if $service{$name}; $vivify_pools = 0; $pool{$name} = Perlbal::Pool->new($name); + $mc->{ctx}{last_created} = $name; return $mc->ok; } } @@ -776,8 +781,13 @@ sub MANAGE_pool { } sub MANAGE_set { - my $mc = shift->parse(qr/^set (\w+)\.([\w\.]+) ?= ?(.+)$/); + my $mc = shift->parse(qr/^set (?:(\w+)[\. ])?([\w\.]+) ?= ?(.+)$/, + "usage: SET [] = "); my ($name, $key, $val) = $mc->args; + unless ($name ||= $mc->{ctx}{last_created}) { + return $mc->err("omitted service/pool name not implied from context"); + } + if (my Perlbal::Service $svc = $service{$name}) { return $svc->set($key, $val, $mc); } elsif (my Perlbal::Pool $pl = $pool{$name}) { @@ -835,12 +845,13 @@ sub load_config { my ($file, $writer) = @_; open (F, $file) or die "Error opening config file ($file): $!\n"; my $verbose = 0; + my $ctx = Perlbal::CommandContext->new; while () { if ($_ =~ /^verbose (on|off)/i) { $verbose = (lc $1 eq 'on' ? 1 : 0); next; } - return 0 unless run_manage_command($_, $writer, $verbose); + return 0 unless run_manage_command($_, $writer, $verbose, $ctx); } close(F); return 1; diff --git a/lib/Perlbal/CommandContext.pm b/lib/Perlbal/CommandContext.pm new file mode 100644 index 0000000..c943b61 --- /dev/null +++ b/lib/Perlbal/CommandContext.pm @@ -0,0 +1,23 @@ +# keep track of the surrounding context for a ManageCommand, so commands +# can be less verbose when in config files + +package Perlbal::CommandContext; +use strict; +use warnings; +use fields ( + 'last_created', # the name of the last pool or service created + ); + +sub new { + my $class = shift; + my $self = fields::new($class); + return $self; +} + +1; + +# Local Variables: +# mode: perl +# c-basic-indent: 4 +# indent-tabs-mode: nil +# End: diff --git a/lib/Perlbal/ManageCommand.pm b/lib/Perlbal/ManageCommand.pm index 0f16699..733f34a 100644 --- a/lib/Perlbal/ManageCommand.pm +++ b/lib/Perlbal/ManageCommand.pm @@ -1,7 +1,5 @@ -###################################################################### -# HTTP connection to backend node -# possible states: connecting, bored, sending_req, wait_res, xfer_res -###################################################################### +# class representing a one-liner management command. all the responses +# to a command should be done through this instance (out, err, ok, etc) package Perlbal::ManageCommand; use strict; @@ -15,10 +13,11 @@ use fields ( 'verbose', 'orig', 'argn', + 'ctx', ); sub new { - my ($class, $base, $cmd, $out, $ok, $err, $orig, $verbose) = @_; + my ($class, $base, $cmd, $out, $ok, $err, $orig, $verbose, $ctx) = @_; my $self = fields::new($class); $self->{base} = $base; @@ -27,6 +26,7 @@ sub new { $self->{err} = $err; $self->{out} = $out; $self->{orig} = $orig; + $self->{ctx} = $ctx; $self->{verbose} = $verbose; $self->{argn} = []; return $self; @@ -41,7 +41,13 @@ sub loud_crasher { sub out { my $mc = shift; return @_ ? $mc->{out}->(@_) : $mc->{out}; } sub ok { my $mc = shift; return $mc->{ok}->(@_); } -sub err { my $mc = shift; return $mc->{err}->(@_); } + +sub err { + my ($mc, $err) = @_; + $err =~ s/\n$//; + $mc->{err}->($err); +} + sub cmd { my $mc = shift; return $mc->{cmd}; } sub orig { my $mc = shift; return $mc->{orig}; } sub end { my $mc = shift; $mc->{out}->("."); 1; } @@ -76,7 +82,7 @@ sub args { sub parse_error { my $mc = shift; my $usage = shift; - + $usage .= "\n" unless $usage =~ /\n$/; die $usage || "Invalid syntax to '$mc->{base}' command\n" } diff --git a/lib/Perlbal/Plugin/Vhosts.pm b/lib/Perlbal/Plugin/Vhosts.pm index 02b4747..21cb214 100644 --- a/lib/Perlbal/Plugin/Vhosts.pm +++ b/lib/Perlbal/Plugin/Vhosts.pm @@ -20,9 +20,12 @@ sub load { my $class = shift; Perlbal::register_global_hook('manage_command.vhost', sub { - my $mc = shift->parse(qr/^vhost\s+(\w+)\s+(\S+)\s*=\s*(\w+)$/, - "usage: VHOST = "); + my $mc = shift->parse(qr/^vhost\s+(?:(\w+)\s+)?(\S+)\s*=\s*(\w+)$/, + "usage: VHOST [] = "); my ($selname, $host, $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")