diff options
Diffstat (limited to 'vespaclient/src/perl')
33 files changed, 4915 insertions, 0 deletions
diff --git a/vespaclient/src/perl/PERL_BEST_PRACTISES b/vespaclient/src/perl/PERL_BEST_PRACTISES new file mode 100644 index 00000000000..29bbc3f01bf --- /dev/null +++ b/vespaclient/src/perl/PERL_BEST_PRACTISES @@ -0,0 +1,361 @@ +To try and make the perl tools good and consistent, here is a list of best +practises used within the modules. + +(Whether they are best can of course be debated, but what's listed is what is +currently used) + +1. Always use strict and warnings first thing. + +There is a lot of stuff legal in perl for backward compatability and ease of +writing one liners. However, these statements are frequent source of bugs in +real code. All modules and binaries should use strict and warnings to ensure +that these checks are enabled. (There is a unit test in the module grepping +source to ensure this). Thus, pretty much the first thing in all perl files +should be: + + use strict; + use warnings; + +2. Use perl modules. + +We want to group functionality into multiple files in perl too. A perl module is +just another perl file with a .pm extension, which minimally can look something +like this: + +Yahoo/Vespa/VespaModel.pm: + + package Yahoo::Vespa::VespaModel; + + use strict; + use warnings; + + my %CACHED_MODEL; # Prevent multiple fetches by caching results + + return 1; + + sub get { + ... + } + +Yahoo/Vespa/Bin/MyBinary.pl: + + use strict; + use warnings; + use Yahoo::Vespa::VespaModel; + + my $model = Yahoo::Vespa::VespaModel::get(); + +2a. Module install locations. + +Perl utilities are installed under $VESPA_HOME/lib/perl5/site_perl + +2b. Aliasing namespace. + +Perl doesn't have that great namespace handling. It's not like in C++, where we +can be in the storage::api namespace and thus address something in the +storage::lib namespace as lib::foo or even refer to another instance in the +same namespace. Thus, if the user of the VespaModel module above were +Yahoo::Vespa::MyLib, it still has to address VespaModel with full path by +default. + +It is possible to create aliases in Perl to help this. Using an alias the +MyBinary.pl code above could look like: + + ... + use Yahoo::Vespa::VespaModel; + + BEGIN { + *VespaModel:: = *Yahoo::Vespa::VespaModel:: ; + } + + my $model = VespaModel::get(); + +The alias declaration doesn't look very pretty, but it can be helpful to get +code looking simple. + +2b. Exporting members into users namespace. + +Another option to using long prefixed names or aliasing, is to export names +into the callers namespace. This can be done in a module doing something like +this: + +Yahoo/Vespa/VespaModel.pm: + + package Yahoo::Vespa::VespaModel; + + use strict; + use warnings; + + BEGIN { + use base 'Exporter'; + our @EXPORT = qw( getVespaModel ); + our @EXPORT_OK = qw( otherFunction ); + } + + my %CACHED_MODEL; + + return 1; + + sub getVespaModel { + ... + } + sub otherFunction { + ... + } + +Yahoo/Vespa/Bin/MyBinary.pl: + + use strict; + use warnings; + use Yahoo::Vespa::VespaModel; + + my $model = getVespaModel(); + +In this example, the getVespaModel function is imported by default, while +otherFunction is not, but can be included optionally. You can specify what to +include by adding arguments to the use statements: + +use Yahoo::Vespa::VespaMode; # Import defaults +use Yahoo::Vespa::VespaModel (); # Import nothing + # Import other function but not getVespaModel +use Yahoo::Vespa::VespaModel qw( otherFunction ); + +(The qw(...) function is just a function to generate an array from a whitespace separated string. Writing qw( foo bar ) is equivalent to writing ('foo', 'bar')) + +You can also export/import variables, but then you need to prefix the names +with the type, as in "our @EXPORT = qw( $number, @list, %hash );". + +Note that you should prefer to export as little functions as possible as they +can clash with names used in caller. Also, the tokens you do export should have +fairly descriptive names to reduce the chance of this happening. An exported +name does not have a module name tagged to it to include context. Thus, if you +don't export you can for instance use Json::encode, but if you do export you +likely need to call the function encodeJson or similar instead. + +2c. Prefer private variables (my instead of our) + +When declaring variables with 'my' they become private to the module, and you +know outsiders can't alter it. This makes it easier when debugging as there are +less possibilities for what can happen. + +2d. Prefer calling functions or exported variables rather than referencing +global variables in a module from the outside. + +Referencing non-declared variables in another module does not seem to create +compiler warnings, nor does using private (my) declared variables. Thus it's +better to refer to imported variables or call a function, such that the +compiler will tell you when this doesn't work anymore. + +2e. Put all function declarations at the bottom. + +When a perl module is loaded, the code within it run. If that doesn't return +true, that means the module fails to load. Thus, traditionally, perl modules +often end with 1; (equivalent to return 1;) to ensure this. However, this mean +you have to read through the entire module to look for module code run. + +By doing exit(...) call in main prog before function declaration and return; in +modules before function declarations, it is easier for reader to see that you +haven't hidden other code between the function declarations. (Unless you've +hacked it into a BEGIN{} block to enforce it to run before everything else) + +2f. Make it easy to reinitialize in unit tests. + +By putting initialization steps in a separate init function, rather than doing +it on load, unit tests can easily call it to reinitialize the module between +tests. Also this separates declarations of what exist from the initialization so +it is easier to see what variables are there. + +3. Confess instead of die. + +The typical perl assert is use of the 'die' function, as in: + + defined $foo or die "We expected 'foo' to be defined here"; + +The Utils package contains a confess function to be used instead (Wrapping an +external dependency), which will do the same as 'die', but will add a +stacktrace too, such that when encountered, it is much easier to find the +culprit. + +4. Do not call exit() in libraries. + +We want to be able to unit test all types of functions in unit tests, also +functionality that makes application abort and exit. The Utils defines an +exitApplication that is mocked for unit tests. Assertion types of exits with +die/confess can also be catched in unit tests. + +5. Code conventions. + + - Upper case, underscore divided, module level variables. + - Camel case function names. + - Four space indent. + +6. Naming function arguments. + +For perl, a function is just a call to a subroutine with a list containing +whatever arguments, called @_. Using this directly makes the code hard to read. +Naming variables makes this a bit easier.. + + sub getVespaModel { # (ConfigServerHost, ConfigServerPort) + return Json::parse(Http::get("http://$_[0]:$_[1]/foo"#)); + } + + sub getVespaModel { # (ConfigServerHost, ConfigServerPort) -> ObjTree + my ($host, $port) = @_; + return Json::parse(Http::get("http://$host:$port/foo"#)); + } + +In the latter example it is easier to read the code. + +The argument comment is something I usually add for function declarations to +look better with vim folding.. When I fold functions in vim, the below line will +look like + ++-- 4 lines: sub getVespaModel (ConfigServerHost, ConfigServerPort) -> ObjTree + +Using such a convention it is thus easier to read the code, as you may be able +to see all your other function declarations while working on the function you +have expanded. + +6b. Functions with many arguments. + +If you create functions with loads of parameters you can end up with a messy +function, and a hard time to adjust all the uses of it when you want to extend +it. At these times you may use hashes to name variables, such that the order +is no longer important.. + + sub getVespaModel { # (ConfigServerHost, ConfigServerPort) -> ObjTree + my $args = $_[0]; + return Json::parse(Http::get("http://$$args{'host':$$args{'port'}/foo"#)); + } + + getVespaModel({ 'host' => 'myhost', 'port' => 80 }); + +Using this trick, you can have defaults for various arguments that can be +ignored by users not caring, rather than having to pass undef at many positions +to ensure order of parameters is correct. + +Note however, that this looks a bit more messy in the function itself, and it +makes it more important to make comments of what arguments are actually handled +and which ones are not optional.. I prefer to try and have short argument +lists instead. + +7. Constants + +Sometimes you want to declare constants. Valid flag values for instance. You +can of course just declare global variables, but you have no way of ensuring +that they never change, which can be confusing. To define constants you can +do the following: + + use constant MY_FLAG => 8; + +This constant is referred to without the usual $ prefix too, so it is easy to +distinguish it from variables. These constants can also be exported, enabling +you to create function calls like: + + MyModule::foo("bar", OPTION_ARGH | OPTION_BAZ); + +Though this of course pollutes callers namespace again, so he has to +specifically not include them if he otherwise would have a name clash. + +8. Libraries not in search path + +Sometimes people install perl libraries in non-default locations. If temporary +you can fix this by add directory to PERLLIB on command line, but if permanent, +the recommended way to find the libraries is to add the directory to the search +path where you include it, like the Yahoo installation for the JSON library: + + use lib '$VESPA_HOME/lib64/perl5/site_perl/5.14/'; + use JSON; + +9. Perl references + +In perl you can create references to variables by prefixing a backslash '\'. + + my @foo ; my $listref = \@foo; + my $var ; my $scalarref = \$var; + my %bar ; my $hashref = \%bar; + +You can also create references to lists and hashes directly: + + my $listref = [ 1, 2, 4 ]; # [] instead of () to get ref instead of list. + my $hashref = { 'foo' => 3, 'bar' => 'hmm' }; # {} instead of () + +To check what a variable is you can use the ref() function: + + ref($scalarref) eq 'SCALAR' + ref($listref) eq 'ARRAY' + ref($hashref) eq 'HASH' + ref($var) == undef + +To dereference a reference you can add a deref clause around it: + my @foo = @{ $listref }; + my %bar = %{ $hashref }; + my $scalar = ${ $scalarref }; + +If the insides of the clause is easy, you also omit it. + my $scalar = $$scalarref; + my %bar = %$hashref; + my $value = $$hashref{'foo'} + +You can also dereference using the -> operator. + my $value = $hashref->{'foo'}; + my $value2 = $listref->[3]; # Element 3 in the list + +The -> operator is typically used when traversing object structures. + +10. Perl structs + +Perl object programming requires some blessing and doesn't look that awesome, +so I typically mostly program functionally. However, at the bare minimum one +needs to be able to create some structs to contain data that isn't bare +primitives. + +Perl's Class::Struct module implements a way to define structs in a simple +fashion without needing to know how bless works, module inheritation and so +forth. + +An example use case here is Yahoo::Vespa::ClusterState + + use Class::Struct; + + struct( ClusterState => { + globalState => '$', + distributor => '%', + storage => '%' + }); + + struct( Node => { + group => '$', + unit => 'State', + generated => 'State', + user => 'State' + }); + + struct( State => { + state => '$', + reason => '$', + timestamp => '$', + source => '$' + }); + +# Some file using it. + + use Yahoo::Vespa::ClusterState; + + my $clusterState = new ClusterState; + $clusterState->globalState('UP'); + my $node = new Node; + $node->group('Foo'); + $clusterState->distributor('0', $node); + + ... + + my $group = $clusterState->distributor->{'0'}->group; + my $nodetype = 'storage'; + my $group = $clusterState->$nodetype->{'0'}->group; + +Some notes: + - The names of the structs are automatically imported. Thus you don't need to + worry about prefixing or aliasing, but be aware names can collide for user. + - $, % or @ indicates if content is scalar, hash or list. A name indicates the + name of another struct that should have the content. diff --git a/vespaclient/src/perl/bin/GetClusterState.pl b/vespaclient/src/perl/bin/GetClusterState.pl new file mode 100755 index 00000000000..2352a5a0ca6 --- /dev/null +++ b/vespaclient/src/perl/bin/GetClusterState.pl @@ -0,0 +1,74 @@ +#!/usr/local/bin/perl -w +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +# BEGIN perl environment bootstrap section +# Do not edit between here and END as this section should stay identical in all scripts + +use File::Basename; +use File::Path; + +sub findpath { + my $myfullname = ${0}; + my($myname, $mypath) = fileparse($myfullname); + + return $mypath if ( $mypath && -d $mypath ); + $mypath=`pwd`; + + my $pwdfullname = $mypath . "/" . $myname; + return $mypath if ( -f $pwdfullname ); + return 0; +} + +# Returns the argument path if it seems to point to VESPA_HOME, 0 otherwise +sub is_vespa_home { + my($VESPA_HOME) = shift; + my $COMMON_ENV="libexec/vespa/common-env.sh"; + if ( $VESPA_HOME && -d $VESPA_HOME ) { + my $common_env = $VESPA_HOME . "/" . $COMMON_ENV; + return $VESPA_HOME if -f $common_env; + } + return 0; +} + +# Returns the home of Vespa, or dies if it cannot +sub findhome { + # Try the VESPA_HOME env variable + return $ENV{'VESPA_HOME'} if is_vespa_home($ENV{'VESPA_HOME'}); + if ( $ENV{'VESPA_HOME'} ) { # was set, but not correctly + die "FATAL: bad VESPA_HOME value '" . $ENV{'VESPA_HOME'} . "'\n"; + } + + # Try the ROOT env variable + $ROOT = $ENV{'ROOT'}; + return $ROOT if is_vespa_home($ROOT); + + # Try the script location or current dir + my $mypath = findpath(); + if ($mypath) { + while ( $mypath =~ s|/[^/]*$|| ) { + return $mypath if is_vespa_home($mypath); + } + } + die "FATAL: Missing VESPA_HOME environment variable\n"; +} + +BEGIN { + my $tmp = findhome(); + if ( $tmp !~ m{[/]$} ) { $tmp .= "/"; } + $ENV{'VESPA_HOME'} = $tmp; +} +my $VESPA_HOME = $ENV{'VESPA_HOME'}; + +# END perl environment bootstrap section + +use lib $ENV{'VESPA_HOME'} . '/lib/perl5/site_perl'; +use Yahoo::Vespa::Defaults; +readConfFile(); + +use strict; +use warnings; +use lib '$VESPA_HOME/lib/perl5/site_perl'; + +use Yahoo::Vespa::Bin::GetClusterState; + +exit(getClusterState(\@ARGV)); diff --git a/vespaclient/src/perl/bin/GetNodeState.pl b/vespaclient/src/perl/bin/GetNodeState.pl new file mode 100755 index 00000000000..d373eadb65b --- /dev/null +++ b/vespaclient/src/perl/bin/GetNodeState.pl @@ -0,0 +1,74 @@ +#!/usr/local/bin/perl -w +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +# BEGIN perl environment bootstrap section +# Do not edit between here and END as this section should stay identical in all scripts + +use File::Basename; +use File::Path; + +sub findpath { + my $myfullname = ${0}; + my($myname, $mypath) = fileparse($myfullname); + + return $mypath if ( $mypath && -d $mypath ); + $mypath=`pwd`; + + my $pwdfullname = $mypath . "/" . $myname; + return $mypath if ( -f $pwdfullname ); + return 0; +} + +# Returns the argument path if it seems to point to VESPA_HOME, 0 otherwise +sub is_vespa_home { + my($VESPA_HOME) = shift; + my $COMMON_ENV="libexec/vespa/common-env.sh"; + if ( $VESPA_HOME && -d $VESPA_HOME ) { + my $common_env = $VESPA_HOME . "/" . $COMMON_ENV; + return $VESPA_HOME if -f $common_env; + } + return 0; +} + +# Returns the home of Vespa, or dies if it cannot +sub findhome { + # Try the VESPA_HOME env variable + return $ENV{'VESPA_HOME'} if is_vespa_home($ENV{'VESPA_HOME'}); + if ( $ENV{'VESPA_HOME'} ) { # was set, but not correctly + die "FATAL: bad VESPA_HOME value '" . $ENV{'VESPA_HOME'} . "'\n"; + } + + # Try the ROOT env variable + $ROOT = $ENV{'ROOT'}; + return $ROOT if is_vespa_home($ROOT); + + # Try the script location or current dir + my $mypath = findpath(); + if ($mypath) { + while ( $mypath =~ s|/[^/]*$|| ) { + return $mypath if is_vespa_home($mypath); + } + } + die "FATAL: Missing VESPA_HOME environment variable\n"; +} + +BEGIN { + my $tmp = findhome(); + if ( $tmp !~ m{[/]$} ) { $tmp .= "/"; } + $ENV{'VESPA_HOME'} = $tmp; +} +my $VESPA_HOME = $ENV{'VESPA_HOME'}; + +# END perl environment bootstrap section + +use lib $ENV{'VESPA_HOME'} . '/lib/perl5/site_perl'; +use Yahoo::Vespa::Defaults; +readConfFile(); + +use strict; +use warnings; +use lib '$VESPA_HOME/lib/perl5/site_perl'; + +use Yahoo::Vespa::Bin::GetNodeState; + +exit(getNodeState(\@ARGV)); diff --git a/vespaclient/src/perl/bin/SetNodeState.pl b/vespaclient/src/perl/bin/SetNodeState.pl new file mode 100755 index 00000000000..7002ab523b5 --- /dev/null +++ b/vespaclient/src/perl/bin/SetNodeState.pl @@ -0,0 +1,71 @@ +#!/usr/local/bin/perl -w +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +# BEGIN perl environment bootstrap section +# Do not edit between here and END as this section should stay identical in all scripts + +use File::Basename; +use File::Path; + +sub findpath { + my $myfullname = ${0}; + my($myname, $mypath) = fileparse($myfullname); + + return $mypath if ( $mypath && -d $mypath ); + $mypath=`pwd`; + + my $pwdfullname = $mypath . "/" . $myname; + return $mypath if ( -f $pwdfullname ); + return 0; +} + +# Returns the argument path if it seems to point to VESPA_HOME, 0 otherwise +sub is_vespa_home { + my($VESPA_HOME) = shift; + my $COMMON_ENV="libexec/vespa/common-env.sh"; + if ( $VESPA_HOME && -d $VESPA_HOME ) { + my $common_env = $VESPA_HOME . "/" . $COMMON_ENV; + return $VESPA_HOME if -f $common_env; + } + return 0; +} + +# Returns the home of Vespa, or dies if it cannot +sub findhome { + # Try the VESPA_HOME env variable + return $ENV{'VESPA_HOME'} if is_vespa_home($ENV{'VESPA_HOME'}); + if ( $ENV{'VESPA_HOME'} ) { # was set, but not correctly + die "FATAL: bad VESPA_HOME value '" . $ENV{'VESPA_HOME'} . "'\n"; + } + + # Try the ROOT env variable + $ROOT = $ENV{'ROOT'}; + return $ROOT if is_vespa_home($ROOT); + + # Try the script location or current dir + my $mypath = findpath(); + if ($mypath) { + while ( $mypath =~ s|/[^/]*$|| ) { + return $mypath if is_vespa_home($mypath); + } + } + die "FATAL: Missing VESPA_HOME environment variable\n"; +} + +BEGIN { + my $tmp = findhome(); + if ( $tmp !~ m{[/]$} ) { $tmp .= "/"; } + $ENV{'VESPA_HOME'} = $tmp; +} +my $VESPA_HOME = $ENV{'VESPA_HOME'}; + +# END perl environment bootstrap section + +use lib $ENV{'VESPA_HOME'} . '/lib/perl5/site_perl'; +use Yahoo::Vespa::Defaults; +readConfFile(); + +use strict; +use warnings; +use Yahoo::Vespa::Bin::SetNodeState; +exit(setNodeState(\@ARGV)); diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/ArgParser.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/ArgParser.pm new file mode 100644 index 00000000000..c6b0fb0f157 --- /dev/null +++ b/vespaclient/src/perl/lib/Yahoo/Vespa/ArgParser.pm @@ -0,0 +1,689 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# Argument parser. +# +# Intentions: +# - Make it very easy for programs to get info from command line. +# - Allow shared libraries to register own options, such that a program can +# delegate command line options to libraries used. (For instance, verbosity +# arguments will be automatically delegated to console output module without +# program needing to care much. +# - Create a unified looking syntax page for all command line tools. +# - Be able to reuse input validation. For instance that an integer don't +# have a decimal point and that a hostname can be resolved. +# + +package Yahoo::Vespa::ArgParser; + +use strict; +use warnings; +use Yahoo::Vespa::ConsoleOutput; +use Yahoo::Vespa::Utils; + +BEGIN { # - Define exports and dependency aliases for module. + use base 'Exporter'; + our @EXPORT = qw( + addArgParserValidator + setProgramBinaryName setProgramDescription + setArgument setOptionHeader + setFlagOption setHostOption setPortOption setStringOption + setIntegerOption setFloatOption setUpCountingOption setDownCountingOption + handleCommandLineArguments + OPTION_SECRET OPTION_INVERTEDFLAG OPTION_REQUIRED + ); + # Alias so we can avoid writing the entire package name + *ConsoleOutput:: = *Yahoo::Vespa::ConsoleOutput:: +} + +my @ARGUMENTS; +my $DESCRIPTION; +my $BINARY_NAME; +my @ARG_SPEC_ARRAY; +my %OPTION_SPEC; +my @OPTION_SPEC_ARRAY; +my $SYNTAX_PAGE; +my $SHOW_HIDDEN; +my @VALIDATORS; +use constant OPTION_SECRET => 1; +use constant OPTION_INVERTEDFLAG => 2; +use constant OPTION_ADDFIRST => 4; +use constant OPTION_REQUIRED => 8; + +# These variables are properties needed by ConsoleOutput module. ArgParser +# handles that modules argument settings as it cannot possibly depend upon +# ArgParser itself. +my $VERBOSITY; # Default verbosity before parsing arguments +my $ANSI_COLORS; # Whether to use ansi colors or not. + +&initialize(); + +return 1; + +########################## Default exported functions ######################## + +sub handleCommandLineArguments { # () Parses and sets all values + my ($args, $validate_args_sub) = @_; + + ®isterInternalParameters(); + if (!&parseCommandLineArguments($args)) { + &writeSyntaxPage(); + exitApplication(1); + } + if (defined $validate_args_sub && !&$validate_args_sub()) { + &writeSyntaxPage(); + exitApplication(1); + } + if ($SYNTAX_PAGE) { + &writeSyntaxPage(); + exitApplication(0); + } +} + +sub addArgParserValidator { # (Validator) Add callback to verify parsing + # Using such callbacks you can verify more than is supported natively by + # argument parser, such that you can fail argument parsing at same step as + # internally supported checks are handled. + scalar @_ == 1 or confess "Invalid number of arguments given."; + push @VALIDATORS, $_[0]; +} +sub setProgramBinaryName { # (Name) Defaults to name used on command line + scalar @_ == 1 or confess "Invalid number of arguments given."; + ($BINARY_NAME) = @_; +} +sub setProgramDescription { # (Description) + scalar @_ == 1 or confess "Invalid number of arguments given."; + ($DESCRIPTION) = @_; +} + +sub setOptionHeader { # (Description) + my ($desc) = @_; + push @OPTION_SPEC_ARRAY, $desc; +} + +sub setFlagOption { # (ids[], Result&, Description, Flags) + scalar @_ >= 3 or confess "Invalid number of arguments given."; + my ($ids, $result, $description, $flags) = @_; + if (!defined $flags) { $flags = 0; } + my %optionspec = ( + 'result' => $result, + 'flags' => $flags, + 'ids' => $ids, + 'description' => $description, + 'arg_count' => 0, + 'initializer' => sub { + $$result = (($flags & OPTION_INVERTEDFLAG) == 0 ? 0 : 1); + return 1; + }, + 'result_evaluator' => sub { + $$result = (($flags & OPTION_INVERTEDFLAG) == 0 ? 1 : 0); + return 1; + } + ); + setGenericOption($ids, \%optionspec); +} +sub setHostOption { # (ids[], Result&, Description, Flags) + my ($ids, $result, $description, $flags) = @_; + my %optionspec = ( + 'result' => $result, + 'flags' => $flags, + 'ids' => $ids, + 'description' => $description, + 'arg_count' => 1, + 'result_evaluator' => sub { + my ($id, $args) = @_; + scalar @$args == 1 or confess "Should have one arg here."; + my $host = $$args[0]; + if (!&validHost($host)) { + printError "Invalid host '$host' given to option '$id'. " + . "Not a valid host\n"; + return 0; + } + printSpam "Set value of '$id' to $host.\n"; + $$result = $host; + return 1; + } + ); + setGenericOption($ids, \%optionspec); +} +sub setPortOption { # (ids[], Result&, Description, Flags) + my ($ids, $result, $description, $flags) = @_; + my %optionspec = ( + 'result' => $result, + 'flags' => $flags, + 'ids' => $ids, + 'description' => $description, + 'arg_count' => 1, + 'result_evaluator' => sub { + my ($id, $args) = @_; + scalar @$args == 1 or confess "Should have one arg here."; + my $val = $$args[0]; + if ($val !~ /^\d+$/ || $val < 0 || $val >= 65536) { + printError "Invalid value '$val' given to port option '$id'." + . " Must be an unsigned 16 bit integer.\n"; + return 0; + } + printSpam "Set value of '$id' to $val.\n"; + $$result = $val; + return 1; + } + ); + setGenericOption($ids, \%optionspec); +} +sub setIntegerOption { # (ids[], Result&, Description, Flags) + my ($ids, $result, $description, $flags) = @_; + my %optionspec = ( + 'result' => $result, + 'flags' => $flags, + 'ids' => $ids, + 'description' => $description, + 'arg_count' => 1, + 'result_evaluator' => sub { + my ($id, $args) = @_; + scalar @$args == 1 or confess "Should have one arg here."; + my $val = $$args[0]; + if ($val !~ /^(?:[-\+])?\d+$/) { + printError "Invalid value '$val' given to integer option " + . "'$id'.\n"; + return 0; + } + printSpam "Set value of '$id' to $val.\n"; + $$result = $val; + return 1; + } + ); + setGenericOption($ids, \%optionspec); +} +sub setFloatOption { # (ids[], Result&, Description, Flags) + my ($ids, $result, $description, $flags) = @_; + my %optionspec = ( + 'result' => $result, + 'flags' => $flags, + 'ids' => $ids, + 'description' => $description, + 'arg_count' => 1, + 'result_evaluator' => sub { + my ($id, $args) = @_; + scalar @$args == 1 or confess "Should have one arg here."; + my $val = $$args[0]; + if ($val !~ /^(?:[-\+])?\d+(?:\.\d+)?$/) { + printError "Invalid value '$val' given to float option " + . "'$id'.\n"; + return 0; + } + printSpam "Set value of '$id' to $val.\n"; + $$result = $val; + return 1; + } + ); + setGenericOption($ids, \%optionspec); +} +sub setStringOption { # (ids[], Result&, Description, Flags) + my ($ids, $result, $description, $flags) = @_; + my %optionspec = ( + 'result' => $result, + 'flags' => $flags, + 'ids' => $ids, + 'description' => $description, + 'arg_count' => 1, + 'result_evaluator' => sub { + my ($id, $args) = @_; + scalar @$args == 1 or confess "Should have one arg here."; + my $val = $$args[0]; + printSpam "Set value of '$id' to $val.\n"; + $$result = $val; + return 1; + } + ); + setGenericOption($ids, \%optionspec); +} +sub setUpCountingOption { # (ids[], Result&, Description, Flags) + my ($ids, $result, $description, $flags) = @_; + my $org = $$result; + my %optionspec = ( + 'result' => $result, + 'flags' => $flags, + 'ids' => $ids, + 'description' => $description, + 'arg_count' => 0, + 'initializer' => sub { + $$result = $org; + return 1; + }, + 'result_evaluator' => sub { + if (!defined $$result) { + $$result = 0; + } + ++$$result; + return 1; + } + ); + setGenericOption($ids, \%optionspec); +} +sub setDownCountingOption { # (ids[], Result&, Description, Flags) + my ($ids, $result, $description, $flags) = @_; + my $org = $$result; + my %optionspec = ( + 'result' => $result, + 'flags' => $flags, + 'ids' => $ids, + 'description' => $description, + 'arg_count' => 0, + 'initializer' => sub { + $$result = $org; + return 1; + }, + 'result_evaluator' => sub { + if (!defined $$result) { + $$result = 0; + } + --$$result; + return 1; + } + ); + setGenericOption($ids, \%optionspec); +} + +sub setArgument { # (Result&, Name, Description) + my ($result, $name, $description, $flags) = @_; + if (!defined $flags) { $flags = 0; } + if (scalar @ARG_SPEC_ARRAY > 0 && ($flags & OPTION_REQUIRED) != 0) { + my $last = $ARG_SPEC_ARRAY[scalar @ARG_SPEC_ARRAY - 1]; + if (($$last{'flags'} & OPTION_REQUIRED) == 0) { + confess "Cannot add required argument after optional argument"; + } + } + my %argspec = ( + 'result' => $result, + 'flags' => $flags, + 'name' => $name, + 'description' => $description, + 'result_evaluator' => sub { + my ($arg) = @_; + $$result = $arg; + return 1; + } + ); + push @ARG_SPEC_ARRAY, \%argspec; +} + +######################## Externally usable functions ####################### + +sub registerInternalParameters { # () + # Register console output parameters too, as the output module can't depend + # on this tool. + setFlagOption( + ['show-hidden'], + \$SHOW_HIDDEN, + 'Also show hidden undocumented debug options.', + OPTION_ADDFIRST); + setDownCountingOption( + ['s'], + \$VERBOSITY, + 'Create less verbose output.', + OPTION_ADDFIRST); + setUpCountingOption( + ['v'], + \$VERBOSITY, + 'Create more verbose output.', + OPTION_ADDFIRST); + setFlagOption( + ['h', 'help'], + \$SYNTAX_PAGE, + 'Show this help page.', + OPTION_ADDFIRST); + + # If color use is supported and turned on by default, give option to not use + if ($ANSI_COLORS) { + setOptionHeader(''); + setFlagOption( + ['nocolors'], + \$ANSI_COLORS, + 'Do not use ansi colors in print.', + OPTION_SECRET | OPTION_INVERTEDFLAG); + } +} +sub setShowHidden { # (Bool) + $SHOW_HIDDEN = ($_[0] ? 1 : 0); +} + +############## Utility functions - Not intended for external use ############# + +sub initialize { # () + $VERBOSITY = 3; + $ANSI_COLORS = Yahoo::Vespa::ConsoleOutput::ansiColorsSupported(); + $DESCRIPTION = undef; + $BINARY_NAME = $0; + if ($BINARY_NAME =~ /\/([^\/]+)$/) { + $BINARY_NAME = $1; + } + %OPTION_SPEC = (); + @OPTION_SPEC_ARRAY = (); + @ARG_SPEC_ARRAY = (); + @VALIDATORS = (); + $SYNTAX_PAGE = undef; + $SHOW_HIDDEN = undef; + @ARGUMENTS = undef; +} +sub parseCommandLineArguments { # (ArgumentListRef) + printDebug "Parsing command line arguments\n"; + @ARGUMENTS = @{ $_[0] }; + foreach my $spec (@OPTION_SPEC_ARRAY) { + if (ref($spec) && exists $$spec{'initializer'}) { + my $initsub = $$spec{'initializer'}; + &$initsub(); + } + } + my %eaten_args; + if (!&parseOptions(\%eaten_args)) { + printDebug "Option parsing failed\n"; + return 0; + } + if (!&parseArguments(\%eaten_args)) { + printDebug "Argument parsing failed\n"; + return 0; + } + ConsoleOutput::setVerbosity($VERBOSITY); + ConsoleOutput::setUseAnsiColors($ANSI_COLORS); + return 1; +} +sub writeSyntaxPage { # () + if (defined $DESCRIPTION) { + printResult $DESCRIPTION . "\n\n"; + } + printResult "Usage: " . $BINARY_NAME; + if (scalar keys %OPTION_SPEC > 0) { + printResult " [Options]"; + } + foreach my $arg (@ARG_SPEC_ARRAY) { + if (($$arg{'flags'} & OPTION_REQUIRED) != 0) { + printResult " <" . $$arg{'name'} . ">"; + } else { + printResult " [" . $$arg{'name'} . "]"; + } + } + printResult "\n"; + + if (scalar @ARG_SPEC_ARRAY > 0) { + &writeArgumentSyntax(); + } + if (scalar keys %OPTION_SPEC > 0) { + &writeOptionSyntax(); + } +} +sub setGenericOption { # (ids[], Optionspec) + my ($ids, $spec) = @_; + if (!defined $$spec{'flags'}) { + $$spec{'flags'} = 0; + } + foreach my $id (@$ids) { + if (length $id == 1 && $id =~ /[0-9]/) { + confess "A short option can not be a digit. Reserved so we can parse " + . "-4 as a negative number argument rather than an option 4"; + } + } + foreach my $id (@$ids) { + $OPTION_SPEC{$id} = $spec; + } + if (($$spec{'flags'} & OPTION_ADDFIRST) == 0) { + push @OPTION_SPEC_ARRAY, $spec; + } else { + unshift @OPTION_SPEC_ARRAY, $spec; + } +} +sub parseArguments { # (EatenArgs) + my ($eaten_args) = @_; + my $stopIndex = 10000000; + my $argIndex = 0; + printSpam "Parsing arguments\n"; + for (my $i=0; $i<scalar @ARGUMENTS; ++$i) { + printSpam "Processing arg '$ARGUMENTS[$i]'.\n"; + if ($i <= $stopIndex && $ARGUMENTS[$i] eq '--') { + printSpam "Found --. Further dash prefixed args will be args\n"; + $stopIndex = $i; + } elsif ($i <= $stopIndex && $ARGUMENTS[$i] =~ /^-/) { + printSpam "Option declaration. Ignoring\n"; + } elsif (exists $$eaten_args{$i}) { + printSpam "Already eaten argument. Ignoring\n"; + } elsif ($argIndex < scalar @ARG_SPEC_ARRAY) { + my $spec = $ARG_SPEC_ARRAY[$argIndex]; + my $name = $$spec{'name'}; + if (!&{$$spec{'result_evaluator'}}($ARGUMENTS[$i])) { + printDebug "Failed evaluate result of arg $name. Aborting\n"; + return 0; + } + printSpam "Successful parsing of argument '$name'.\n"; + $$eaten_args{$i} = 1; + ++$argIndex; + } else { + printError "Unhandled argument '$ARGUMENTS[$i]'.\n"; + return 0; + } + } + if ($SYNTAX_PAGE) { # Ignore required arg check if syntax page is to be shown + return 1; + } + for (my $i=$argIndex; $i<scalar @ARG_SPEC_ARRAY; ++$i) { + my $spec = $ARG_SPEC_ARRAY[$i]; + if (($$spec{'flags'} & OPTION_REQUIRED) != 0) { + my $name = $$spec{'name'}; + printError "Argument $name is required but not specified.\n"; + return 0; + } + } + return 1; +} +sub getOptionArguments { # (Count, MinIndex, EatenArgs) + my ($count, $minIndex, $eaten_args) = @_; + my $stopIndex = 10000000; + my @result; + if ($count == 0) { return \@result; } + for (my $i=0; $i<scalar @ARGUMENTS; ++$i) { + printSpam "Processing arg '$ARGUMENTS[$i]'.\n"; + if ($i <= $stopIndex && $ARGUMENTS[$i] eq '--') { + printSpam "Found --. Further dash prefixed args will be args\n"; + $stopIndex = $i; + } elsif ($i <= $stopIndex && $ARGUMENTS[$i] =~ /^-[^0-9]/) { + printSpam "Option declaration. Ignoring\n"; + } elsif (exists $$eaten_args{$i}) { + printSpam "Already eaten argument. Ignoring\n"; + } elsif ($i < $minIndex) { + printSpam "Not eaten, but too low index to be option arg.\n"; + } else { + printSpam "Using argument\n"; + push @result, $ARGUMENTS[$i]; + $$eaten_args{$i} = 1; + if (scalar @result == $count) { + return \@result; + } + } + } + printSpam "Too few option arguments found. Returning undef\n"; + return; +} +sub parseOption { # (Id, EatenArgs, Index) + my ($id, $eaten_args, $index) = @_; + if (!exists $OPTION_SPEC{$id}) { + printError "Unknown option '$id'.\n"; + return 0; + } + my $spec = $OPTION_SPEC{$id}; + my $args = getOptionArguments($$spec{'arg_count'}, $index, $eaten_args); + if (!defined $args) { + printError "Too few arguments for option '$id'.\n"; + return 0; + } + printSpam, "Found " . (scalar @$args) . " args\n"; + if (!&{$$spec{'result_evaluator'}}($id, $args)) { + printDebug "Failed evaluate result of option '$id'. Aborting\n"; + return 0; + } + printSpam "Successful parsing of option '$id'.\n"; + return 1; +} +sub parseOptions { # (EatenArgs) + my ($eaten_args) = @_; + for (my $i=0; $i<scalar @ARGUMENTS; ++$i) { + if ($ARGUMENTS[$i] =~ /^--(.+)$/) { + my $id = $1; + printSpam "Parsing long option '$id'.\n"; + if (!&parseOption($id, $eaten_args, $i)) { + return 0; + } + } elsif ($ARGUMENTS[$i] =~ /^-([^0-9].*)$/) { + my $shortids = $1; + while ($shortids =~ /^(.)(.*)$/) { + my ($id, $rest) = ($1, $2); + printSpam "Parsing short option '$id'.\n"; + if (!&parseOption($id, $eaten_args, $i)) { + return 0; + } + $shortids = $rest; + } + } + } + printSpam "Successful parsing of all options.\n"; + return 1; +} +sub writeArgumentSyntax { # () + printResult "\nArguments:\n"; + my $max_name_length = &getMaxNameLength(); + if ($max_name_length > 30) { $max_name_length = 30; } + foreach my $spec (@ARG_SPEC_ARRAY) { + &writeArgumentName($$spec{'name'}, $max_name_length); + &writeOptionDescription($spec, $max_name_length + 3); + } +} +sub getMaxNameLength { # () + my $max = 0; + foreach my $spec (@ARG_SPEC_ARRAY) { + my $len = 1 + length $$spec{'name'}; + if ($len > $max) { $max = $len; } + } + return $max; +} +sub writeArgumentName { # (Name, MaxNameLength) + my ($name, $maxnamelen) = @_; + printResult " $name"; + my $totalLength = 1 + length $name; + if ($totalLength <= $maxnamelen) { + for (my $i=$totalLength; $i<$maxnamelen; ++$i) { + printResult ' '; + } + } else { + printResult "\n"; + for (my $i=0; $i<$maxnamelen; ++$i) { + printResult ' '; + } + } + printResult " : "; +} +sub writeOptionSyntax { # () + printResult "\nOptions:\n"; + my $max_id_length = &getMaxIdLength(); + if ($max_id_length > 30) { $max_id_length = 30; } + my $cachedHeader; + foreach my $spec (@OPTION_SPEC_ARRAY) { + if (ref($spec) eq 'HASH') { + my $flags = $$spec{'flags'}; + if ($SHOW_HIDDEN || ($flags & OPTION_SECRET) == 0) { + if (defined $cachedHeader) { + printResult "\n"; + if ($cachedHeader ne '') { + &writeOptionHeader($cachedHeader); + } + $cachedHeader = undef; + } + &writeOptionId($spec, $max_id_length); + &writeOptionDescription($spec, $max_id_length + 3); + } + } else { + $cachedHeader = $spec; + } + } +} +sub getMaxIdLength { # () + my $max = 0; + foreach my $spec (@OPTION_SPEC_ARRAY) { + if (!ref($spec)) { next; } # Ignore option headers + my $size = 0; + foreach my $id (@{ $$spec{'ids'} }) { + my $len = length $id; + if ($len == 1) { + $size += 3; + } else { + $size += 3 + $len; + } + } + if ($size > $max) { $max = $size; } + } + return $max; +} +sub writeOptionId { # (Spec, MaxNameLength) + my ($spec, $maxidlen) = @_; + my $totalLength = 0; + foreach my $id (@{ $$spec{'ids'} }) { + my $len = length $id; + if ($len == 1) { + printResult " -" . $id; + $totalLength += 3; + } else { + printResult " --" . $id; + $totalLength += 3 + $len; + } + } + if ($totalLength <= $maxidlen) { + for (my $i=$totalLength; $i<$maxidlen; ++$i) { + printResult ' '; + } + } else { + printResult "\n"; + for (my $i=0; $i<$maxidlen; ++$i) { + printResult ' '; + } + } + printResult " : "; +} +sub writeOptionDescription { # (Spec, MaxNameLength) + my ($spec, $maxidlen) = @_; + my $width = ConsoleOutput::getTerminalWidth() - $maxidlen; + my $desc = $$spec{'description'}; + my $min = int ($width / 2); + while (length $desc > $width) { + if ($desc =~ /^(.{$min,$width}) (.*)$/s) { + my ($first, $rest) = ($1, $2); + printResult $first . "\n"; + for (my $i=0; $i<$maxidlen; ++$i) { + printResult ' '; + } + $desc = $rest; + } else { + last; + } + } + printResult $desc . "\n"; +} +sub writeOptionHeader { # (Description) + my ($desc) = @_; + my $width = ConsoleOutput::getTerminalWidth(); + my $min = 2 * $width / 3; + while (length $desc > $width) { + if ($desc =~ /^(.{$min,$width}) (.*)$/s) { + my ($first, $rest) = ($1, $2); + printResult $first . "\n"; + $desc = $rest; + } else { + last; + } + } + printResult $desc . "\n"; +} +sub validHost { # (Hostname) + my ($host) = @_; + if ($host !~ /^[a-zA-Z][-_a-zA-Z0-9\.]*$/) { + return 0; + } + if (system("host $host >/dev/null 2>/dev/null") != 0) { + return 0; + } + return 1; +} diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetClusterState.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetClusterState.pm new file mode 100644 index 00000000000..13d645d46de --- /dev/null +++ b/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetClusterState.pm @@ -0,0 +1,124 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +package Yahoo::Vespa::Bin::GetClusterState; + +use strict; +use warnings; +use Yahoo::Vespa::ArgParser; +use Yahoo::Vespa::ClusterController; +use Yahoo::Vespa::ConsoleOutput; +use Yahoo::Vespa::ContentNodeSelection; +use Yahoo::Vespa::Utils; +use Yahoo::Vespa::VespaModel; + +BEGIN { + use base 'Exporter'; + our @EXPORT = qw( + getClusterState + ); +} + +my %cluster_states; + +return &init(); + +sub init { + %cluster_states = (); + return 1; +} + +# Run the get node state tool +sub getClusterState { # (Command line arguments) + my ($argsref) = @_; + &handleCommandLine($argsref); + detectClusterController(); + &showSettings(); + &showNodeStates(); +} + +# Parse command line arguments +sub handleCommandLine { # (Command line arguments) + my ($args) = @_; + my $description = <<EOS; +Get the cluster state of a given cluster. + +EOS + $description =~ s/(\S)\n(\S)/$1 $2/gs; + chomp $description; + + setProgramDescription($description); + Yahoo::Vespa::ContentNodeSelection::registerCommandLineArguments( + NO_LOCALHOST_CONSTRAINT | CLUSTER_ONLY_LIMITATION); + Yahoo::Vespa::VespaModel::registerCommandLineArguments(); + handleCommandLineArguments($args); +} + +# Show what settings this tool is running with (if verbosity is high enough) +sub showSettings { # () + &Yahoo::Vespa::ClusterController::showSettings(); +} + +# Print all state we want to show for this request +sub showNodeStates { # () + + Yahoo::Vespa::ContentNodeSelection::visit(\&showNodeStateForNode); +} + +# Get the node state from cluster controller, unless already cached +sub getStateForNode { # (Type, Index, Cluster) + my ($type, $index, $cluster) = @_; + if (!exists $cluster_states{$cluster}) { + my $state = getContentClusterState($cluster); + $cluster_states{$cluster} = $state; + if ($state->globalState eq "up") { + printResult "\nCluster $cluster:\n"; + } else { + printResult "\nCluster $cluster is " . COLOR_ERR + . $state->globalState . COLOR_RESET + . ". Too few nodes available.\n"; + } + } + return $cluster_states{$cluster}->$type->{$index}; +} + +# Print all states for a given node +sub showNodeStateForNode { # (Service, Index, NodeState, Model, ClusterName) + my ($info) = @_; + my ($cluster, $type, $index) = ( + $$info{'cluster'}, $$info{'type'}, $$info{'index'}); + my $nodestate = &getStateForNode($type, $index, $cluster); + defined $nodestate or confess "No nodestate for $type $index $cluster"; + my $generated = $nodestate->generated; + my $id = $cluster . "/"; + if (defined $nodestate->group) { + $id .= $nodestate->group; + } + my $msg = "$cluster/$type/$index: "; + if ($generated->state ne 'up') { + $msg .= COLOR_ERR; + } + $msg .= $generated->state; + if ($generated->state ne 'up') { + $msg .= COLOR_RESET; + } + # TODO: Make the Cluster Controller always populate the reason for the + # generated state. Until then we'll avoid printing it to avoid confusion. + # Use vespa-get-node-state to see the reasons on generated, user, and unit. + # + # if (length $generated->reason > 0) { + # $msg .= ': ' . $generated->reason; + # } + printResult $msg . "\n"; +} + +# ClusterState(Version: 7, Cluster state: Up, Distribution bits: 1) { +# Group 0: mygroup. 1 node [0] { +# All nodes in group up and available. +# } +# } + +# ClusterState(Version: 7, Cluster state: Up, Distribution bits: 1) { +# Group 0: mygroup. 1 node [0] { +# storage.0: Retired: foo +# } +# } diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetNodeState.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetNodeState.pm new file mode 100644 index 00000000000..1e82c05db0a --- /dev/null +++ b/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetNodeState.pm @@ -0,0 +1,119 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +package Yahoo::Vespa::Bin::GetNodeState; + +use strict; +use warnings; +use Yahoo::Vespa::ArgParser; +use Yahoo::Vespa::ClusterController; +use Yahoo::Vespa::ConsoleOutput; +use Yahoo::Vespa::ContentNodeSelection; +use Yahoo::Vespa::Utils; + +BEGIN { + use base 'Exporter'; + our @EXPORT = qw( + getNodeState + ); +} + +our $resultdesc; +our %cluster_states; + +return 1; + +# Run the get node state tool +sub getNodeState { # (Command line arguments) + my ($argsref) = @_; + &handleCommandLine($argsref); + detectClusterController(); + &showSettings(); + &showNodeStates(); +} + +# Parse command line arguments +sub handleCommandLine { # (Command line arguments) + my ($args) = @_; + $resultdesc = <<EOS; +Shows the various states of one or more nodes in a Vespa Storage cluster. +There exist three different type of node states. They are: + + Unit state - The state of the node seen from the cluster controller. + User state - The state we want the node to be in. By default up. Can be + set by administrators or by cluster controller when it + detects nodes that are behaving badly. + Generated state - The state of a given node in the current cluster state. + This is the state all the other nodes know about. This + state is a product of the other two states and cluster + controller logic to keep the cluster stable. +EOS + $resultdesc =~ s/\s*\n(\S.)/ $1/gs; + chomp $resultdesc; + my $description = <<EOS; +Retrieve the state of one or more storage services from the fleet controller. +Will list the state of the locally running services, possibly restricted to +less by options. + +$resultdesc + +EOS + $description =~ s/(\S)\n(\S)/$1 $2/gs; + chomp $description; + + setProgramDescription($description); + Yahoo::Vespa::ContentNodeSelection::registerCommandLineArguments(); + Yahoo::Vespa::VespaModel::registerCommandLineArguments(); + handleCommandLineArguments($args); +} + +# Show what settings this tool is running with (if verbosity is high enough) +sub showSettings { # () + &Yahoo::Vespa::ClusterController::showSettings(); + &Yahoo::Vespa::ContentNodeSelection::showSettings(); +} + +# Print all state we want to show for this request +sub showNodeStates { # () + printInfo $resultdesc . "\n"; + Yahoo::Vespa::ContentNodeSelection::visit(\&showNodeStateForNode); +} + +# Get the node state from cluster controller, unless already cached +sub getStateForNode { # (Type, Index, Cluster) + my ($type, $index, $cluster) = @_; + if (!exists $cluster_states{$cluster}) { + $cluster_states{$cluster} = getContentClusterState($cluster); + } + return $cluster_states{$cluster}->$type->{$index}; +} + +# Print all states for a given node +sub showNodeStateForNode { # (Service, Index, NodeState, Model, ClusterName) + my ($info) = @_; + my ($cluster, $type, $index) = ( + $$info{'cluster'}, $$info{'type'}, $$info{'index'}); + printResult "\n$cluster/$type.$index:\n"; + my $nodestate = &getStateForNode($type, $index, $cluster); + printState('Unit', $nodestate->unit); + printState('Generated', $nodestate->generated); + printState('User', $nodestate->user); +} + +# Print the value of a single state type for a node +sub printState { # (State name, State) + my ($name, $state) = @_; + if (!defined $state) { + printResult $name . ": UNKNOWN\n"; + } else { + my $msg = $name . ": "; + if ($state->state ne 'up') { + $msg .= COLOR_ERR; + } + $msg .= $state->state; + if ($state->state ne 'up') { + $msg .= COLOR_RESET; + } + $msg .= ": " . $state->reason . "\n"; + printResult $msg; + } +} diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/SetNodeState.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/SetNodeState.pm new file mode 100644 index 00000000000..bdf276c3677 --- /dev/null +++ b/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/SetNodeState.pm @@ -0,0 +1,97 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +package Yahoo::Vespa::Bin::SetNodeState; + +use strict; +use warnings; +use Yahoo::Vespa::ClusterController; +use Yahoo::Vespa::ConsoleOutput; +use Yahoo::Vespa::ContentNodeSelection; +use Yahoo::Vespa::ArgParser; +use Yahoo::Vespa::Utils; + +BEGIN { + use base 'Exporter'; + our @EXPORT = qw( + setNodeState + ); +} + +our $wanted_state; +our $wanted_state_description; +our $nodes_attempted_set; +our $success; + +return 1; + +# Run the set node state tool +sub setNodeState { # (Command line arguments) + my ($argsref) = @_; + &handleCommandLine($argsref); + detectClusterController(); + &showSettings(); + &execute(); +} + +# Parse command line arguments +sub handleCommandLine { # (Command line arguments) + my ($args) = @_; + my $description = <<EOS; +Set the user state of a node. This will set the generated state to the user +state if the user state is "better" than the generated state that would have +been created if the user state was up. For instance, a node that is currently +in initializing state can be forced into down state, while a node that is +currently down can not be forced into retired state, but can be forced into +maintenance state. +EOS + $description =~ s/(\S)\n(\S)/$1 $2/gs; + chomp $description; + + setProgramDescription($description); + + setArgument(\$wanted_state, "Wanted State", + "User state to set. This must be one of " + . "up, down, maintenance or retired.", + OPTION_REQUIRED); + setArgument(\$wanted_state_description, "Description", + "Give a reason for why you are altering the user state, which " + . "will show up in various admin tools. (Use double quotes to " + . "give a reason with whitespace in it)"); + + Yahoo::Vespa::ContentNodeSelection::registerCommandLineArguments(); + Yahoo::Vespa::VespaModel::registerCommandLineArguments(); + handleCommandLineArguments($args); + + if (!Yahoo::Vespa::ContentNodeSelection::validateCommandLineArguments( + $wanted_state)) { + exitApplication(1); + } +} + +# Show what settings this tool is running with (if verbosity is high enough) +sub showSettings { # () + Yahoo::Vespa::ClusterController::showSettings(); +} + +# Sets the node state +sub execute { # () + $success = 1; + $nodes_attempted_set = 0; + Yahoo::Vespa::ContentNodeSelection::visit(\&setNodeStateForNode); + if ($nodes_attempted_set == 0) { + printWarning("Attempted setting of user state for no nodes"); + exitApplication(1); + } + if (!$success) { + exitApplication(1); + } +} + +sub setNodeStateForNode { + my ($info) = @_; + my ($cluster, $type, $index) = ( + $$info{'cluster'}, $$info{'type'}, $$info{'index'}); + $success &&= setNodeUserState($cluster, $type, $index, $wanted_state, + $wanted_state_description); + ++$nodes_attempted_set; +} diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterController.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterController.pm new file mode 100644 index 00000000000..cbe6deea9e4 --- /dev/null +++ b/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterController.pm @@ -0,0 +1,273 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# Handles Rest API requests to State Rest API in cluster controller, making +# wanted data programmatically available. +# +package Yahoo::Vespa::ClusterController; + +use strict; +use warnings; +use Class::Struct; +use Yahoo::Vespa::ArgParser; +use Yahoo::Vespa::ClusterState; +use Yahoo::Vespa::ConsoleOutput; +use Yahoo::Vespa::Http; +use Yahoo::Vespa::Json; +use Yahoo::Vespa::Utils; +use Yahoo::Vespa::VespaModel; + +BEGIN { # - Exports and aliases for the module + use base 'Exporter'; + our $VERSION = '1.0'; + our @EXPORT = qw( + detectClusterController + getContentClusterState + setNodeUserState + ); # Exported unless specifically left out by user + # Alias namespaces + *VespaModel:: = *Yahoo::Vespa::VespaModel:: ; + *Http:: = *Yahoo::Vespa::Http:: ; + *Json:: = *Yahoo::Vespa::Json:: ; +} + +struct( ClusterController => { + index => '$', # Logical index of the cluster controller + host => '$', # Host on which cluster controller runs + port => '$' # Port where cluster controller is available +}); + +my %CACHED_CLUSTER_STATES; +my @CLUSTER_CONTROLLERS; + +return &init(); + +########################## Default exported functions ######################## + +sub init { + %CACHED_CLUSTER_STATES = (); + @CLUSTER_CONTROLLERS = (); + return 1; +} + +sub detectClusterController { # () + if (scalar @CLUSTER_CONTROLLERS == 0) { + use Yahoo::Vespa::VespaModel; + printDebug "Attempting to auto-detect cluster controller location\n"; + my $sockets = VespaModel::getSocketForService( + type => 'container-clustercontroller', tag => 'state'); + foreach my $sock (sort { $a->{'index'} <=> $b->{'index'} } @$sockets) { + my $cc = new ClusterController; + $cc->index($sock->{'index'}); + $cc->host($sock->{'host'}); + $cc->port($sock->{'port'}); + push @CLUSTER_CONTROLLERS, $cc; + } + if (scalar @$sockets == 0) { + my $oldVal = enableAutomaticLineBreaks(0); + printSpam dumpStructure(VespaModel::get()); + enableAutomaticLineBreaks($oldVal); + printError "Failed to detect cluster controller to talk to. " + . "Resolve issue that failed automatic detection or " + . "provide cluster controller socket through command " + . "line options. (See --help)\n"; + exitApplication(1); + } + &showSettings(); + printSpam "Content of vespa model inspected to find cluster " + . "controller:\n"; + my $oldVal = enableAutomaticLineBreaks(0); + printSpam dumpStructure(VespaModel::get()); + enableAutomaticLineBreaks($oldVal); + } +} +sub setNodeUserState { # (ClusterName, NodeType, Index, State, Reason) + my ($cluster, $service, $index, $state, $reason) = @_; + my @params = (); + my @headers = ( + 'Content-Type' => 'application/json' + ); + $state =~ tr/A-Z/a-z/; + $state =~ /(?:up|down|maintenance|retired)$/ + or confess "Invalid state '$state' attempted set.\n"; + if (!defined $reason) { + $reason = ""; + } + my $request = { + "state" => { + "user" => { + "state" => $state, + "reason" => $reason + } + } + }; + my $content = Json::encode($request); + + my $path = &getPathToNode($cluster, $service, $index); + my %response = &requestCC('POST', $path, \@params, $content, \@headers); + if (defined $response{'all'}) { printSpam $response{'all'}; } + printDebug $response{'code'} . " " . $response{'status'} . "\n"; + printInfo exists($response{'content'}) ? $response{'content'} : ''; + if ($response{'code'} >= 200 && $response{'code'} < 300) { + printResult "$response{'status'}\n"; + return 1 + } else { + printWarning "Failed to set node state for node " + . "$cluster/$service/$index: " + . "$response{'code'} $response{'status'}\n"; + return 0 + } +} +sub getContentClusterState { # (ClusterName) -> ClusterState + my ($cluster) = @_; + if (!exists $CACHED_CLUSTER_STATES{$cluster}) { + $CACHED_CLUSTER_STATES{$cluster} = &fetchContentClusterState($cluster); + } + return $CACHED_CLUSTER_STATES{$cluster}; +} + +######################## Externally usable functions ####################### + +sub getClusterControllers { # () + return \@CLUSTER_CONTROLLERS; +} +sub showSettings { # () + printDebug "Cluster controllers:\n"; + foreach my $cc (@CLUSTER_CONTROLLERS) { + printDebug " " . $cc->index . ": " + . $cc->host . ":" . $cc->port . "\n"; + } +} + +############## Utility functions - Not intended for external use ############# + +sub fetchContentClusterState { # (ClusterName) -> ClusterState + my ($cluster) = @_; + my @params = ( + 'recursive' => 'true' + ); + my %response = &getCC("/cluster/v2/$cluster/", \@params); + if ($response{'code'} != 200) { + printError "Failed to fetch cluster state of content cluster " + . "'$cluster':\n" . $response{'all'} . "\n"; + exitApplication(1); + } + my $json = Json::parse($response{'content'}); + my $result = new ClusterState; + &fillInGlobalState($cluster, $result, $json); + &fillInNodes($result, 'distributor', + &getJsonValue($json, ['service', 'distributor', 'node'])); + &fillInNodes($result, 'storage', + &getJsonValue($json, ['service', 'storage', 'node'])); + return $result; +} +sub fillInGlobalState { # (ClusterName, StateToFillIn, JsonToParse) + my ($cluster, $state, $json) = @_; + my $e = &getJsonValue($json, ['state', 'generated', 'state']); + if (defined $e) { + $state->globalState($e); + if (!Yahoo::Vespa::ClusterState::legalState($state->globalState())) { + printWarning "Illegal global cluster state $e found.\n"; + } + } else { + printDebug dumpStructure($json) . "\n"; + printWarning "Found no global cluster state\n"; + } +} +sub getPathToNode { # (ClusterName, NodeType, Index) + my ($cluster, $service, $index) = @_; + return "/cluster/v2/$cluster/$service/$index"; +} +sub listContentClusters { # () -> (ContentClusterName, ...) + my %result = &getCC("/cluster/v2/"); + if ($result{'code'} != 200) { + printError "Failed to fetch list of content clusters:\n" + . $result{'all'} . "\n"; + exitApplication(1); + } + my $json = Json::parse($result{'content'}); + return keys %{ $json->{'cluster'} }; +} +sub fillInNodes { # (StateToFillIn, ServiceType, json) + my ($state, $service, $json) = @_; + foreach my $index (%{ $json }) { + my $node = new Node; + &parseNode($node, $json->{$index}); + $state->$service($index, $node); + } +} +sub parseNode { # (StateToFillIn, JsonToParse) + my ($node, $json) = @_; + my $group = &getJsonValue($json, ['attributes', 'hierarchical-group']); + if (defined $group && $group =~ /^[^\.]*\.(.*)$/) { + $node->group($1); + } + parseState($node, $json, 'unit'); + parseState($node, $json, 'generated'); + parseState($node, $json, 'user'); + my $partitions = $json->{'partition'}; + if (defined $partitions) { + foreach my $index (%{ $json->{'partition'} }) { + my $partition = new Partition; + parsePartition($partition, $json->{'partition'}->{$index}); + $node->partition($index, $partition); + } + } +} +sub parsePartition { # (StateToFillIn, JsonToParse) + my ($partition, $json) = @_; + my $buckets = &getJsonValue($json, ['metrics', 'bucket-count']); + my $doccount = &getJsonValue($json, ['metrics', 'unique-document-count']); + my $size = &getJsonValue($json, ['metrics', 'unique-document-total-size']); + $partition->bucketcount($buckets); + $partition->doccount($doccount); + $partition->totaldocsize($size); +} +sub parseState { # (StateToFillIn, JsonToParse, StateType) + my ($node, $json, $type) = @_; + my $value = &getJsonValue($json, ['state', $type, 'state']); + my $reason = &getJsonValue($json, ['state', $type, 'reason']); + if (defined $value) { + my $state = new State; + $state->state($value); + $state->reason($reason); + $state->source($type); + $node->$type($state); + } +} +sub getJsonValue { # (json, [ keys ]) + my ($json, $keys) = @_; + foreach my $key (@$keys) { + if (!defined $json) { return; } + $json = $json->{$key}; + } + return $json; +} +sub getCC { # (Path, Params, Headers) -> Response + my ($path, $params, $headers) = @_; + return requestCC('GET', $path, $params, undef, $headers); +} +sub requestCC { # (Type, Path, Params, Content, Headers) -> Response + my ($type, $path, $params, $content, $headers) = @_; + my %response; + foreach my $cc (@CLUSTER_CONTROLLERS) { + %response = Http::request($type, $cc->host, $cc->port, $path, + $params, $content, $headers); + if ($response{'code'} == 200) { + return %response; + } elsif ($response{'code'} == 307) { + my %headers = $response{'headers'}; + my $masterlocation = $headers{'Location'}; + if (defined $masterlocation) { + if ($masterlocation =~ /http:\/\/([^\/:]+):(\d+)\//) { + my ($host, $port) = ($1, $2); + return Http::request($type, $host, $port, $path, + $params, $content, $headers); + } else { + printError("Unhandled relocaiton URI '$masterlocation'."); + exitApplication(1); + } + } + } + } + return %response; +} diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterState.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterState.pm new file mode 100644 index 00000000000..648f158f9db --- /dev/null +++ b/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterState.pm @@ -0,0 +1,45 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# Defines structs to represent a cluster state +# +package Yahoo::Vespa::ClusterState; + +use strict; +use warnings; +use Class::Struct; + +struct( ClusterState => { + globalState => '$', # A state primitive + distributor => '%', # Index to Node map + storage => '%' # Index to Node map +}); + +struct( Node => { + group => '$', # Hierarchical group node belongs to + unit => 'State', + generated => 'State', + user => 'State', + partition => '%' +}); + +struct( Partition => { + generated => 'State', + bucketcount => '$', + doccount => '$', + totaldocsize => '$' +}); + +struct( State => { + state => '$', # A state primitive + reason => '$', # Textual reason for it to be set. + timestamp => '$', # Timestamp of the time it got set. + source => '$' # What type of state is it (unit/generated/user) +}); + +return 1; + +sub legalState { # (State) -> Bool + my ($state) = @_; + return ($state =~ /^(up|down|maintenance|retired|stopping|initializing)$/); +} + diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/ConsoleOutput.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/ConsoleOutput.pm new file mode 100644 index 00000000000..73a0a016592 --- /dev/null +++ b/vespaclient/src/perl/lib/Yahoo/Vespa/ConsoleOutput.pm @@ -0,0 +1,331 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# Output handler +# +# Intentions: +# - Make it easy for unit tests to redirect output. +# - Allow programmers to add all sorts of debug information into tools usable +# for debugging, while hiding it by default for real users. +# - Allow generic functionality that can be reused by all. For instance color +# coding of very important information. +# +# Ideas for improvement: +# - Could possibly detect terminal width and do proper line breaking of long +# lines +# +# A note about colors: +# - This module will detect if terminal supports colors. If not, it will not +# print any. (Color support can be turned off by giving --nocolors argument +# through argument parser, by setting a TERM value that does not support +# colors or programmatically call setUseAnsiColors(0). +# - Currently only red and grey are used in addition to default. These colors +# should work well for both light and dark backgrounds. +# + +package Yahoo::Vespa::ConsoleOutput; + +use strict; +use warnings; +use Yahoo::Vespa::Utils; + +BEGIN { # - Define exports for modul + use base 'Exporter'; + our @EXPORT = qw( + printResult printError printWarning printInfo printDebug printSpam + enableAutomaticLineBreaks + COLOR_RESET COLOR_WARN COLOR_ERR COLOR_ANON + ); + our @EXPORT_OK = qw( + getTerminalWidth getVerbosity usingAnsiColors ansiColorsSupported + setVerbosity + ); +} + +my %TYPES = ( + 'result' => 0, # Output from a tool. Expected when app runs successfully. + 'error' => 1, # Error found, typically aborting the script with a failure. + 'warning' => 2, # An issue that may or may not cause the program to fail. + 'info' => 3, # Useful information to get from the script. + 'debug' => 4, # Debug information useful to debug script or to see + # internals of what is happening. + 'spam' => 5, # Spammy information used when large amounts of details is + # wanted. Typically to debug some failure. +); +my $VERBOSITY; # Current verbosity level +my $ANSI_COLORS_SUPPORTED; # True if terminal supports colors +my $ANSI_COLORS; # True if we want to use colors (and support it) +my %ATTRIBUTE_PREFIX; # Ansi escape prefixes for verbosity levels +my %ATTRIBUTE_POSTFIX; # Ansi escape postfixes for verbosity levels +my %OUTPUT_STREAM; # Where to write different verbosity levels (stdout|stderr) +my $TERMINAL_WIDTH; # With of terminal in columns +my $COLUMN_POSITION; # Current index of cursor in terminal +my $ENABLE_AUTO_LINE_BREAKS; + +use constant COLOR_RESET => "\e[0m"; +use constant COLOR_ERR => "\e[91m"; +use constant COLOR_WARN => "\e[93m"; +use constant COLOR_ANON => "\e[90m"; + +&initialize(*STDOUT, *STDERR); + +return 1; + +########################## Default exported functions ######################## + +sub printResult { # (Output...) + printAtLevel('result', @_); +} +sub printError { # (Output...) + printAtLevel('error', @_); +} +sub printWarning { # (Output...) + printAtLevel('warning', @_); +} +sub printInfo { # (Output...) + printAtLevel('info', @_); +} +sub printDebug { # (Output...) + printAtLevel('debug', @_); +} +sub printSpam { # (Output...) + printAtLevel('spam', @_); +} +sub enableAutomaticLineBreaks { # (Bool) -> (OldValue) + my $oldval = $ENABLE_AUTO_LINE_BREAKS; + $ENABLE_AUTO_LINE_BREAKS = ($_[0] ? 1 : 0); + return $oldval; +} + +######################## Optionally exported functions ####################### + +sub getTerminalWidth { # () -> ColumnCount + # May be undefined if someone prints before initialized + return (defined $TERMINAL_WIDTH ? $TERMINAL_WIDTH : 80); +} +sub getVerbosity { # () -> VerbosityLevel + return $VERBOSITY; +} +sub usingAnsiColors { # () -> Bool + return $ANSI_COLORS; +} +sub ansiColorsSupported { # () -> Bool + return $ANSI_COLORS_SUPPORTED; +} +sub setVerbosity { # (VerbosityLevel) + $VERBOSITY = $_[0]; +} + +################## Functions for unit tests to mock internals ################ + +sub setTerminalWidth { # (ColumnCount) + $TERMINAL_WIDTH = $_[0]; +} +sub setUseAnsiColors { # (Bool) + if ($ANSI_COLORS_SUPPORTED && $_[0]) { + $ANSI_COLORS = 1; + } else { + $ANSI_COLORS = 0; + } +} + +############## Utility functions - Not intended for external use ############# + +sub initialize { # () + my ($stdout, $stderr, $use_colors_by_default) = @_; + if (!defined $VERBOSITY) { + $VERBOSITY = &getDefaultVerbosity(); + } + $COLUMN_POSITION = 0; + $ENABLE_AUTO_LINE_BREAKS = 1; + %ATTRIBUTE_PREFIX = map { $_ => '' } keys %TYPES; + %ATTRIBUTE_POSTFIX = map { $_ => '' } keys %TYPES; + &setAttribute('error', COLOR_ERR, COLOR_RESET); + &setAttribute('warning', COLOR_WARN, COLOR_RESET); + &setAttribute('debug', COLOR_ANON, COLOR_RESET); + &setAttribute('spam', COLOR_ANON, COLOR_RESET); + %OUTPUT_STREAM = map { $_ => $stdout } keys %TYPES; + $OUTPUT_STREAM{'error'} = $stderr; + $OUTPUT_STREAM{'warning'} = $stderr; + if (defined $use_colors_by_default) { + $ANSI_COLORS_SUPPORTED = $use_colors_by_default; + $ANSI_COLORS = $ANSI_COLORS_SUPPORTED; + } else { + &detectTerminalColorSupport(); + } + if (!defined $TERMINAL_WIDTH) { + $TERMINAL_WIDTH = &detectTerminalWidth(); + } +} +sub setAttribute { # (type, prefox, postfix) + my ($type, $prefix, $postfix) = @_; + $ATTRIBUTE_PREFIX{$type} = $prefix; + $ATTRIBUTE_POSTFIX{$type} = $postfix; +} +sub stripAnsiEscapes { # (Line) -> (StrippedLine) + $_[0] =~ s/\e\[[^m]*m//g; + return $_[0]; +} +sub getDefaultVerbosity { # () -> VerbosityLevel + # We can not print at correct verbosity levels before argument parsing has + # completed. We try some simple arg parsing here assuming default options + # used to set verbosity, such that we likely guess correctly, allowing + # correct verbosity from the start. + my $default = 3; + foreach my $arg (@ARGV) { + if ($arg eq '--') { return $default; } + if ($arg =~ /^-([^-]+)/) { + my $optstring = $1; + while ($optstring =~ /^(.)(.*)$/) { + my $char = $1; + $optstring = $2; + if ($char eq 'v') { + ++$default; + } + if ($char eq 's') { + if ($default > 0) { + --$default; + } + } + } + } + } + return $default; +} +sub detectTerminalWidth { #() -> ColumnCount + my $cols = &checkConsoleFeature('cols'); + if (!defined $cols) { + printDebug "Assuming terminal width of 80.\n"; + return 80; + } + if ($cols =~ /^\d+$/ && $cols > 10 && $cols < 500) { + printDebug "Detected terminal width of $cols.\n"; + return $cols; + } else { + printDebug "Unexpected terminal width of '$cols' given. " + . "Assuming size of 80.\n"; + return 80; + } +} +sub detectTerminalColorSupport { # () -> Bool + my $colorcount = &checkConsoleFeature('colors'); + if (!defined $colorcount) { + $ANSI_COLORS_SUPPORTED = 0; + printDebug "Assuming no color support.\n"; + return 0; + } + if ($colorcount =~ /^\d+$/ && $colorcount >= 8) { + $ANSI_COLORS_SUPPORTED = 1; + if (!defined $ANSI_COLORS) { + $ANSI_COLORS = $ANSI_COLORS_SUPPORTED; + } + printDebug "Color support detected.\n"; + return 1; + } +} +sub checkConsoleFeature { # (Feature) -> Bool + my ($feature) = @_; + # Unit tests must mock. Can't depend on TERM being set. + assertNotUnitTest(); + if (!exists $ENV{'TERM'}) { + printDebug "Terminal not set. Unknown.\n"; + return; + } + if (-f '/usr/bin/tput') { + my ($fh, $result); + if (open ($fh, "tput $feature 2>/dev/null |")) { + $result = <$fh>; + close $fh; + } else { + printDebug "Failed to open tput pipe.\n"; + return; + } + if ($? != 0) { + printDebug "Failed tput call to detect feature $feature $!\n"; + return; + } + chomp $result; + #printSpam "Console feature $feature: '$result'\n"; + return $result; + } else { + printDebug "No tput binary. Dont know how to detect feature.\n"; + return; + } +} +sub printAtLevel { # (Level, Output...) + # Prints an array of data that may contain newlines + my $level = shift @_; + exists $TYPES{$level} or confess "Unknown print level '$level'."; + if ($TYPES{$level} > $VERBOSITY) { + return; + } + my $buffer = ''; + my $width = &getTerminalWidth(); + foreach my $printable (@_) { + my @lines = split(/\n/, $printable, -1); + my $current = 0; + for (my $i=0; $i < scalar @lines; ++$i) { + if ($i != 0) { + $buffer .= "\n"; + $COLUMN_POSITION = 0; + } + my $last = ($i + 1 == scalar @lines); + printLineAtLevel($level, $lines[$i], \$buffer, $last); + } + } + my $stream = $OUTPUT_STREAM{$level}; + print $stream $buffer; +} +sub printLineAtLevel { # (Level, Line, Buffer, Last) + # Prints a single line, which might still have to be broken into multiple + # lines + my ($level, $data, $buffer, $last) = @_; + if (!$ANSI_COLORS) { + $data = &stripAnsiEscapes($data); + } + my $width = &getTerminalWidth(); + while (1) { + my $remaining = $width - $COLUMN_POSITION; + if (&prefixLineWithLevel($level)) { + $remaining -= (2 + length $level); + } + if ($ENABLE_AUTO_LINE_BREAKS && $remaining < length $data) { + my $min = int (2 * $width / 3) - $COLUMN_POSITION; + if ($min < 1) { $min = 1; } + if ($data =~ /^(.{$min,$remaining}) (.*?)$/s) { + my ($first, $rest) = ($1, $2); + &printLinePartAtLevel($level, $first, $buffer); + $$buffer .= "\n"; + $data = $rest; + $COLUMN_POSITION = 0; + } else { + last; + } + } else { + last; + } + } + if (!$last || length $data > 0) { + &printLinePartAtLevel($level, $data, $buffer); + } +} +sub printLinePartAtLevel { # ($Level, Line, Buffer) + # Print a single line that should fit on one line + my ($level, $data, $buffer) = @_; + if ($ANSI_COLORS) { + $$buffer .= $ATTRIBUTE_PREFIX{$level}; + } + if (&prefixLineWithLevel($level)) { + $$buffer .= $level . ": "; + $COLUMN_POSITION = (length $level) + 2; + } + $$buffer .= $data; + $COLUMN_POSITION += length $data; + if ($ANSI_COLORS) { + $$buffer .= $ATTRIBUTE_POSTFIX{$level}; + } +} +sub prefixLineWithLevel { # (Level) -> Bool + my ($level) = @_; + return ($TYPES{$level} > 2 && $VERBOSITY >= 4 && $COLUMN_POSITION == 0); +} + diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/ContentNodeSelection.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/ContentNodeSelection.pm new file mode 100644 index 00000000000..f5507ce478e --- /dev/null +++ b/vespaclient/src/perl/lib/Yahoo/Vespa/ContentNodeSelection.pm @@ -0,0 +1,141 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# This module implements a way to select a subset of nodes from a Vespa +# application. +# + +package Yahoo::Vespa::ContentNodeSelection; + +use strict; +use warnings; +use Yahoo::Vespa::ArgParser; +use Yahoo::Vespa::ConsoleOutput; +use Yahoo::Vespa::Utils; +use Yahoo::Vespa::VespaModel; + +BEGIN { # - Declare exports and dependency aliases for module + use base 'Exporter'; + our @EXPORT = qw( + NO_LOCALHOST_CONSTRAINT + CLUSTER_ONLY_LIMITATION + ); + # Package aliases + *VespaModel:: = *Yahoo::Vespa::VespaModel:: ; +} + +my $CLUSTER; +my $NODE_TYPE; +my $INDEX; +my $FORCE = 0; +our $LOCALHOST; + +use constant NO_LOCALHOST_CONSTRAINT => 1; +use constant CLUSTER_ONLY_LIMITATION => 2; + +return 1; + +######################## Externally usable functions ####################### + +sub registerCommandLineArguments { # (Flags) + my ($flags) = @_; + if (!defined $flags) { $flags = 0; } + if (($flags & NO_LOCALHOST_CONSTRAINT) == 0) { + $LOCALHOST = getHostname(); + } else { + $LOCALHOST = undef; + } + if (($flags & CLUSTER_ONLY_LIMITATION) == 0) { + setOptionHeader("Node selection options. By default, nodes running " + . "locally will be selected:"); + } + setStringOption( + ['c', 'cluster'], + \$CLUSTER, + 'Cluster name of cluster to query. ' + . 'If unspecified, and vespa is installed on current node, ' + . 'information will be attempted auto-extracted'); + setFlagOption( + ['f', 'force'], + \$FORCE, + 'Force the execution of a dangerous command.'); + if (($flags & CLUSTER_ONLY_LIMITATION) == 0) { + setStringOption( + ['t', 'type'], + \$NODE_TYPE, + 'Node type to query. This can either be \'storage\' or ' + . '\'distributor\'. If not specified, the operation will show ' + . 'state for all types.'); + setIntegerOption( + ['i', 'index'], + \$INDEX, + 'The node index to show state for. If not specified, all nodes ' + . 'found running on this host will be shown.'); + } +} +sub visit { # (Callback) + my ($callback) = @_; + printDebug "Visiting selected services: " + . "Cluster " . (defined $CLUSTER ? $CLUSTER : 'undef') + . " node type " . (defined $NODE_TYPE ? $NODE_TYPE : 'undef') + . " index " . (defined $INDEX ? $INDEX : 'undef') + . " localhost only ? " . ($LOCALHOST ? "true" : "false") . "\n"; + VespaModel::visitServices(sub { + my ($info) = @_; + $$info{'type'} = &convertType($$info{'type'}); + if (!&validType($$info{'type'})) { return; } + if (defined $CLUSTER && $CLUSTER ne $$info{'cluster'}) { return; } + if (defined $NODE_TYPE && $NODE_TYPE ne $$info{'type'}) { return; } + if (defined $INDEX && $INDEX ne $$info{'index'}) { return; } + if (!defined $INDEX && defined $LOCALHOST + && $LOCALHOST ne $$info{'host'}) + { + return; + } + # printResult "Ok $$info{'cluster'} $$info{'type'} $$info{'index'}\n"; + &$callback($info); + }); +} +sub showSettings { # () + printDebug "Visiting selected services: " + . "Cluster " . (defined $CLUSTER ? $CLUSTER : 'undef') + . " node type " . (defined $NODE_TYPE ? $NODE_TYPE : 'undef') + . " index " . (defined $INDEX ? $INDEX : 'undef') + . " localhost only ? " . ($LOCALHOST ? "true" : "false") . "\n"; +} + +sub validateCommandLineArguments { # (WantedState) + my ($wanted_state) = @_; + + if (defined $NODE_TYPE) { + if ($NODE_TYPE !~ /^(distributor|storage)$/) { + printWarning "Invalid value '$NODE_TYPE' given for node type.\n"; + return 0; + } + } + + if (!$FORCE && + (!defined $NODE_TYPE || $NODE_TYPE eq "distributor") && + $wanted_state eq "maintenance") { + printWarning "Setting the distributor to maintenance mode may have " + . "severe consequences for feeding!\n" + . "Please specify -t storage to only set the storage node to " + . "maintenance mode, or -f to override this error.\n"; + return 0; + } + + printDebug "Command line arguments validates ok\n"; + return 1; +} + +############## Utility functions - Not intended for external use ############# + +sub validType { # (ServiceType) -> Bool + my ($type) = @_; + return $type =~ /^(?:distributor|storage)$/; +} +sub convertType { # (ServiceType) -> Bool + my ($type) = @_; + if ($type eq 'storagenode') { return 'storage'; } + return $type; +} + diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/Http.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/Http.pm new file mode 100644 index 00000000000..8e25442a64d --- /dev/null +++ b/vespaclient/src/perl/lib/Yahoo/Vespa/Http.pm @@ -0,0 +1,160 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# Simple HTTP wrapper library +# +# Intentions: +# - Make it very easy for programs to do HTTP requests towards Rest APIs. +# - Allow unit tests to fake returned data +# - Allow using another external dependency for HTTP without affecting apps +# +# An HTTP request returns a Response that is a hash containing: +# code - The HTTP status code +# status - The HTTP status string that comes with the code +# content - The content of the reply +# all - The entire response coming over the TCP connection +# This is here for debugging and testing. If you need specifics like +# HTTP headers, we should just add specific fields for them rather than +# to parse all content. +# +# Examples: +# +# my @headers = ( +# "X-Foo" => 'Bar' +# ); +# my @params = ( +# "verbose" => 1 +# ); +# +# $response = Http::get('localhost', 80, '/status.html'); +# $response = Http::get('localhost', 80, '/status.html', \@params, \@headers); +# $response = Http::request('POST', 'localhost', 80, '/test', \@params, +# "Some content", \@headers); +# + +package Yahoo::Vespa::Http; + +use strict; +use warnings; + +use Net::INET6Glue::INET_is_INET6; +use LWP::Simple (); +use URI (); +use URI::Escape qw( uri_escape ); +use Yahoo::Vespa::ConsoleOutput; +use Yahoo::Vespa::Utils; + +my %LEGAL_TYPES; +my $BROWSER; +my $EXECUTE; + +&initialize(); + +return 1; + +######################## Externally usable functions ####################### + +sub get { # (Host, Port, Path, Params, Headers) -> Response + my ($host, $port, $path, $params, $headers) = @_; + return &request('GET', $host, $port, $path, $params, undef, $headers); +} +sub request { # (Type, Host, Port, Path, Params, Content, Headers) -> Response + my ($type, $host, $port, $path, $params, $content, $headers) = @_; + if (!exists $LEGAL_TYPES{$type}) { + confess "Invalid HTTP type '$type' specified."; + } + if (defined $params && ref($params) ne "ARRAY") { + confess 'HTTP request attempted without array ref for params'; + } + if (defined $headers && ref($headers) ne "ARRAY") { + confess 'HTTP request attempted without array ref for headers'; + } + return &$EXECUTE( + $type, $host, $port, $path, $params, $content, $headers); +} +sub encodeForm { # (KeyValueMap) -> RawString + my $data; + for (my $i=0; $i < scalar @_; $i += 2) { + my ($key, $value) = ($_[$i], $_[$i+1]); + if ($i != 0) { + $data .= '&'; + } + $data .= uri_escape($key); + if (defined $value) { + $data .= '=' . uri_escape($value); + } + } + return $data; +} + +################## Functions for unit tests to mock internals ################ + +sub setHttpExecutor { # (Function) + $EXECUTE = $_[0] +} + +############## Utility functions - Not intended for external use ############# + +sub initialize { # () + %LEGAL_TYPES = map { $_ => 1 } ( 'GET', 'POST', 'PUT', 'DELETE'); + $BROWSER = LWP::UserAgent->new; + $BROWSER->agent('Vespa-perl-script'); + $EXECUTE = \&execute; +} +sub execute { # (Type, Host, Port, Path, Params, Content, Headers) -> Response + my ($type, $host, $port, $path, $params, $content, $headers) = @_; + if (!defined $headers) { $headers = []; } + if (!defined $params) { $params = []; } + my $url = URI->new(&buildUri($host, $port, $path)); + if (defined $params) { + $url->query_form(@$params); + } + printSpam "Performing HTTP request $type '$url'.\n"; + my $response; + if ($type eq 'GET') { + !defined $content or confess "$type requests cannot have content"; + $response = $BROWSER->get($url, @$headers); + } elsif ($type eq 'POST') { + if (defined $content) { + $response = $BROWSER->post($url, $params, @$headers, + 'Content' => $content); + } else { + $response = $BROWSER->post($url, $params, @$headers); + } + } elsif ($type eq 'PUT') { + if (defined $content) { + $response = $BROWSER->put($url, $params, @$headers, + 'Content' => $content); + } else { + $response = $BROWSER->put($url, $params, @$headers); + } + } elsif ($type eq 'DELETE') { + !defined $content or confess "$type requests cannot have content"; + $response = $BROWSER->put($url, $params, @$headers); + } else { + confess "Unknown type $type"; + } + my $autoLineBreak = enableAutomaticLineBreaks(0); + printSpam "Got HTTP result: '" . $response->as_string . "'\n"; + enableAutomaticLineBreaks($autoLineBreak); + return ( + 'code' => $response->code, + 'headers' => $response->headers(), + 'status' => $response->message, + 'content' => $response->content, + 'all' => $response->as_string + ); +} +sub buildUri { # (Host, Port, Path) -> UriString + my ($host, $port, $path) = @_; + my $uri = "http:"; + if (defined $host) { + $uri .= '//' . $host; + if (defined $port) { + $uri .= ':' . $port; + } + } + if (defined $path) { + $uri .= $path; + } + return $uri; +} diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/Json.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/Json.pm new file mode 100644 index 00000000000..8acadbe59ae --- /dev/null +++ b/vespaclient/src/perl/lib/Yahoo/Vespa/Json.pm @@ -0,0 +1,52 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# Minimal JSON wrapper. +# +# Intentions: +# - If needed, be able to switch the implementation of the JSON parser +# without components using this class seeing it. +# - Make API as simple as possible to use. +# +# Currently uses JSON.pm from ypan/perl-JSON +# +# Example usage: +# +# my $json = <<EOS; +# { +# 'foo' : [ +# { 'key1' : 2 }, +# { 'key2' : 5 } +# ] +# } +# +# my $result = Json::parse($json); +# my $firstkey = $result->{'foo'}->[0]->{'key1'} +# my @keys = @{ $result->{'foo'} }; +# +# See JsonTest for more usage. Add tests there if unsure. +# + +package Yahoo::Vespa::Json; + +use strict; +use warnings; + # Location of JSON.pm is not in default search path on tested Yahoo nodes. +use lib ($ENV{'VESPA_HOME'} . '/lib64/perl5/site_perl/5.14/'); +use JSON; + +return 1; + +# Parses a string with json data returning an object tree +sub parse { # (RawString) -> ObjTree + my ($raw) = @_; + my $json = decode_json($raw); + return $json; +} + +# Encodes an object tree as returned from parse back to a raw string +sub encode { # (ObjTree) -> RawString + my ($json) = @_; + my $JSON = JSON->new->allow_nonref; + my $encoded = $JSON->pretty->encode($json); + return $encoded; +} diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/Utils.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/Utils.pm new file mode 100644 index 00000000000..63e1a3093bc --- /dev/null +++ b/vespaclient/src/perl/lib/Yahoo/Vespa/Utils.pm @@ -0,0 +1,97 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# Some simple utilities to allow unit tests to mock behavior. +# + +package Yahoo::Vespa::Utils; + +use strict; +use warnings; +use Carp (); +use Sys::Hostname qw(hostname); + +BEGIN { # - Define exports from this module + use base 'Exporter'; + our @EXPORT = qw( + exitApplication + getHostname + confess + assertNotUnitTest + dumpStructure + ); +} + +my $HOSTNAME; +my $EXIT_HANDLER; +my $IS_UNIT_TEST; + +&initialize(); + +return 1; + +########################## Default exported functions ######################## + +# Use this function to get hostname to allow unit test mocking for tests to be +# independent of computer they run on. +sub getHostname { # () + if (!defined $HOSTNAME) { + $HOSTNAME = hostname; + &assertNotUnitTest(); + $HOSTNAME = `hostname`; + chomp $HOSTNAME; + } + return $HOSTNAME; +} + +# Use instead of exit() to allow unit tests to mock the call to avoid aborting +sub exitApplication { #(ExitCode) + if ($IS_UNIT_TEST && $EXIT_HANDLER == \&defaultExitHandler) { + &confess("Exit handler not overridden in unit test"); + } + &$EXIT_HANDLER(@_); +} + +# Use instead of die to get backtrace when dieing +sub confess { # (Reason) + Carp::confess(@_); +} + +# Call for behavior that you want to ensure is not used in unit tests. +# Typically unit tests have to mock commands that for instance fetch host name +# or require that terminal is set etc. Unit tests use mocks for this. This +# command can be used in code, such that unit tests die if they reach the +# non-mocked code. +sub assertNotUnitTest { # () + if ($IS_UNIT_TEST) { + confess "Unit tests should not reach here. Mock required. " + . "Initialize mock"; + } +} + +# Use to look at content of a perl struct. +sub dumpStructure { # (ObjTree) -> ReadableString + my ($var) = @_; + use Data::Dumper; + local $Data::Dumper::Indent = 1; + local $Data::Dumper::Sortkeys = 1; + return Dumper($var); +} + +################## Functions for unit tests to mock internals ################ + +sub initializeUnitTest { # (Hostname, ExitHandler) + my ($host, $exitHandler) = @_; + $IS_UNIT_TEST = 1; + $HOSTNAME = $host; + $EXIT_HANDLER = $exitHandler; +} + +############## Utility functions - Not intended for external use ############# + +sub initialize { # () + $EXIT_HANDLER = \&defaultExitHandler; +} +sub defaultExitHandler { # () + my ($exitcode) = @_; + exit($exitcode); +} diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/VespaModel.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/VespaModel.pm new file mode 100644 index 00000000000..9e1fd90eeb3 --- /dev/null +++ b/vespaclient/src/perl/lib/Yahoo/Vespa/VespaModel.pm @@ -0,0 +1,350 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# Vespa model +# +# Make vespa model information available for tools. To for instance get an +# overview of where services are running. +# +# Possible improvements: +# +# - Depending on config Rest API and config server might be better than +# depending on getvespaconfig tool and config format. +# - Support direct communication with config server if config proxy is not +# running (unless getvespaconfig does that for us) +# - Support specifying config server, to be able to run tool external from the +# vespa system to talk to. +# - Return a list of all matching sockets instead of first found. +# - Be able to specify a set of port tags needed for a match. +# + +package Yahoo::Vespa::VespaModel; + +use strict; +use warnings; +use Yahoo::Vespa::ArgParser; +use Yahoo::Vespa::ConsoleOutput; +use Yahoo::Vespa::Utils; + +my $RETRIEVE_MODEL_CONFIG; # Allow unit tests to switch source of config info +my $MODEL; +my $CONFIG_SERVER_HOST; +my $CONFIG_SERVER_PORT; +my $CONFIG_REQUEST_TIMEOUT; + +&initialize(); + +return 1; + +######################## Externally usable functions ####################### + +sub registerCommandLineArguments { # () + setOptionHeader("Config retrieval options:"); + setHostOption( + ['config-server'], + \$CONFIG_SERVER_HOST, + 'Host name of config server to query'); + setPortOption( + ['config-server-port'], + \$CONFIG_SERVER_PORT, + 'Port to connect to config server on'); + setFloatOption( + ['config-request-timeout'], + \$CONFIG_REQUEST_TIMEOUT, + 'Timeout of config request'); +} + +sub visitServices { # (Callback) + my $model = &get(); + my ($callback) = @_; + my @services = @{ &getServices($model); }; + foreach my $service (sort serviceOrder @services) { + &$callback($service); + } +} + +sub getServices { + my $model = &get(); + my @result; + foreach my $hostindex (keys %{ $$model{'hosts'} }) { + my $host = ${ $$model{'hosts'} }{ $hostindex }; + foreach my $serviceindex (keys %{ $$host{'services'} }) { + my $service = ${ $$host{'services'} }{ $serviceindex }; + my %info = ( + 'name' => $$service{'name'}, + 'type' => $$service{'type'}, + 'configid' => $$service{'configid'}, + 'cluster' => $$service{'clustername'}, + 'host' => $$host{'name'} + ); + if (exists $$service{'index'}) { + $info{'index'} = $$service{'index'}; + } + push @result, \%info; + } + } + return \@result; +} + +# Get socket for given service matching given conditions (Given as a hash) +# Legal conditions: +# type - Service type +# tag - Port tag +# index - Service index +# clustername - Name of cluster. +# Example: getSocketForService( 'type' => 'distributor', 'index' => 3, +# 'tag' => 'http', 'tag' => 'state' ); +sub getSocketForService { # (Conditions) => [{host=>$,port=>$,index=>$}...] + my $model = &get(); + my $conditions = \@_; + printDebug "Looking at model to find socket for a service.\n"; + &validateConditions($conditions); + my $hosts = $$model{'hosts'}; + if (!defined $hosts) { return; } + my @results; + foreach my $hostindex (keys %$hosts) { + my $host = $$hosts{$hostindex}; + my $services = $$host{'services'}; + if (defined $services) { + printSpam "Searching services on host $$host{'name'}\n"; + foreach my $serviceindex (keys %$services) { + my $service = $$services{$serviceindex}; + my $type = $$service{'type'}; + my $cluster = $$service{'clustername'}; + if (!&serviceTypeMatchConditions($conditions, $type)) { + printSpam "Unwanted service '$type'.\n"; + next; + } + if (!&indexMatchConditions($conditions, $$service{'index'})) { + printSpam "Unwanted index '$$service{'index'}'.\n"; + next; + } + if (!&clusterNameMatchConditions($conditions, $cluster)) { + printSpam "Unwanted index '$$service{'index'}'.\n"; + next; + } + my $ports = $$service{'ports'}; + if (defined $ports) { + my $resultcount = 0; + foreach my $portindex (keys %$ports) { + my $port = $$ports{$portindex}; + my $tags = $$port{'tags'}; + if (defined $tags) { + if (!&tagsMatchConditions($conditions, $tags)) { + next; + } + } + push @results, { 'host' => $$host{'name'}, + 'port' => $$port{'number'}, + 'index' => $$service{'index'} }; + ++$resultcount; + } + if ($resultcount == 0) { + printSpam "No ports with acceptable tags found. " + . "Ignoring $type.$$service{'index'}\n"; + } + } else { + printSpam "No ports defined. " + . "Ignoring $type.$$service{'index'}\n"; + } + } + } + } + return \@results; +} + +############## Utility functions - Not intended for external use ############# + +sub initialize { # () + $RETRIEVE_MODEL_CONFIG = \&retrieveModelConfigDefault; +} +sub setModelRetrievalFunction { # (Function) + $RETRIEVE_MODEL_CONFIG = $_[0]; +} +sub retrieveModelConfigDefault { # () + my $VESPA_HOME= $ENV{'VESPA_HOME'}; + my $cmd = ${VESPA_HOME} . '/bin/getvespaconfig -n cloud.config.model -i admin/model'; + + if (defined $CONFIG_REQUEST_TIMEOUT) { + $cmd .= " -w $CONFIG_REQUEST_TIMEOUT"; + } + + my $temp = `${VESPA_HOME}/libexec/vespa/vespa-config.pl -configsources`; + my @configSources = split(",", $temp); + my $firstConfigSource = $configSources[0]; + if (!defined $CONFIG_SERVER_HOST) { + my @temp = split('/', $firstConfigSource); + my @configHost = split(':', $temp[1]); + $CONFIG_SERVER_HOST = $configHost[0]; + } + $cmd .= " -s $CONFIG_SERVER_HOST"; + + if (!defined $CONFIG_SERVER_PORT) { + my @configPort = split(':', $firstConfigSource); + $CONFIG_SERVER_PORT = $configPort[1]; + } + $cmd .= " -p $CONFIG_SERVER_PORT"; + + printDebug "Fetching model config '$cmd'.\n"; + my @data = `$cmd 2>&1`; + if ($? != 0 || join(' ', @data) =~ /^error/) { + printError "Failed to get model config from config command line tool:\n" + . "Command: $cmd\n" + . "Exit code: $?\n" + . "Output: " . join("\n", @data) . "\n"; + exitApplication(1); + } + return @data; +} +sub fetch { # () + my @data = &$RETRIEVE_MODEL_CONFIG(); + $MODEL = &parseConfig(@data); + return $MODEL; +} +sub get { # () + if (!defined $MODEL) { + return &fetch(); + } + return $MODEL; +} +sub validateConditions { # (ConditionArrayRef) + my ($condition) = @_; + for (my $i=0, my $n=scalar @$condition; $i<$n; $i += 2) { + if ($$condition[$i] !~ /^(type|tag|index|clustername)$/) { + printError "Invalid socket for service condition " + . "'$$condition[$i]' given.\n"; + exitApplication(1); + } + } +} +sub tagsMatchConditions { # (Condition, TagList) -> Bool + my ($condition, $taglist) = @_; + my %tags = map { $_ => 1 } @$taglist; + for (my $i=0, my $n=scalar @$condition; $i<$n; $i += 2) { + if ($$condition[$i] eq 'tag' && !exists $tags{$$condition[$i + 1]}) { + return 0; + } + } + return 1; +} +sub serviceTypeMatchConditions { # (Condition, ServiceType) -> Bool + my ($condition, $type) = @_; + for (my $i=0, my $n=scalar @$condition; $i<$n; $i += 2) { + if ($$condition[$i] eq 'type' && $$condition[$i + 1] ne $type) { + return 0; + } + } + return 1; +} +sub clusterNameMatchConditions { # (Condition, ClusterName) -> Bool + my ($condition, $cluster) = @_; + for (my $i=0, my $n=scalar @$condition; $i<$n; $i += 2) { + if ($$condition[$i] eq 'clustername' && $$condition[$i + 1] ne $cluster) + { + return 0; + } + } + return 1; +} +sub indexMatchConditions { # (Condition, Index) -> Bool + my ($condition, $index) = @_; + for (my $i=0, my $n=scalar @$condition; $i<$n; $i += 2) { + if ($$condition[$i] eq 'index' && $$condition[$i + 1] ne $index) { + return 0; + } + } + return 1; +} +sub parseConfig { # () + my $model = {}; + printDebug "Parsing vespa model raw config to create object tree\n"; + my $autoLineBreak = enableAutomaticLineBreaks(0); + foreach my $line (@_) { + chomp $line; + printSpam "Parsing line '$line'\n"; + if ($line =~ /^hosts\[(\d+)\]\.(([a-z]+).*)$/) { + my ($hostindex, $tag, $rest) = ($1, $3, $2); + my $host = &getHost($hostindex, $model); + if ($tag eq 'services') { + &parseService($host, $rest); + } else { + &parseValue($host, $rest); + } + } + } + enableAutomaticLineBreaks($autoLineBreak); + return $model; +} +sub parseService { # (Host, Line) + my ($host, $line) = @_; + if ($line =~ /^services\[(\d+)\].(([a-z]+).*)$/) { + my ($serviceindex, $tag, $rest) = ($1, $3, $2); + my $service = &getService($serviceindex, $host); + if ($tag eq 'ports') { + &parsePort($service, $rest); + } else { + &parseValue($service, $rest); + } + } +} +sub parsePort { # (Service, Line) + my ($service, $line) = @_; + if ($line =~ /^ports\[(\d+)\].(([a-z]+).*)$/) { + my ($portindex, $tag, $rest) = ($1, $3, $2); + my $port = &getPort($portindex, $service); + &parseValue($port, $rest); + } +} +sub parseValue { # (Entity, Line) + my ($entity, $line) = @_; + $line =~ /^(\S+) (?:\"(.*)\"|(\d+))$/ or confess "Unexpected line '$line'."; + my ($id, $string, $number) = ($1, $2, $3); + if ($id eq 'tags' && defined $string) { + my @tags = split(/\s+/, $string); + $$entity{$id} = \@tags; + } elsif (defined $string) { + $$entity{$id} = $string; + } else { + defined $number or confess "Should not happen"; + $$entity{$id} = $number; + } +} +sub getEntity { # (Type, Index, ParentEntity) + my ($type, $index, $parent) = @_; + if (!exists $$parent{$type}) { + $$parent{$type} = {}; + } + my $list = $$parent{$type}; + if (!exists $$list{$index}) { + $$list{$index} = {}; + } + return $$list{$index}; +} +sub getHost { # (Index, Model) + return &getEntity('hosts', $_[0], $_[1]); +} +sub getService { # (Index, Host) + return &getEntity('services', $_[0], $_[1]); +} +sub getPort { # (Index, Service) + return &getEntity('ports', $_[0], $_[1]); +} +sub serviceOrder { + if ($a->{'cluster'} ne $b->{'cluster'}) { + return $a->{'cluster'} cmp $b->{'cluster'}; + } + if ($a->{'type'} ne $b->{'type'}) { + return $a->{'type'} cmp $b->{'type'}; + } + if ($a->{'index'} != $b->{'index'}) { + return $a->{'index'} <=> $b->{'index'}; + } + if ($a->{'host'} ne $b->{'host'}) { + return $a->{'host'} cmp $b->{'host'}; + } + if ($a->{'configid'} ne $b->{'configid'}) { + return $a->{'configid'} cmp $b->{'configid'}; + } + confess "Unsortable elements: " . dumpStructure($a) . "\n" + . dumpStructure($b) . "\n"; +} + diff --git a/vespaclient/src/perl/test/Generic/UseTest.pl b/vespaclient/src/perl/test/Generic/UseTest.pl new file mode 100644 index 00000000000..d2c051d395a --- /dev/null +++ b/vespaclient/src/perl/test/Generic/UseTest.pl @@ -0,0 +1,34 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# That that all perl files use strict and warnings +# + +use Test::More; +use TestUtils::VespaTest; + +use strict; +use warnings; + +my @dirs = ( + '../bin', + '../lib', + 'Yahoo/Vespa/Mocks' +); + +my $checkdirs = join(' ', @dirs); + +my @files = `find $checkdirs -name \\*.pm -or -name \\*.pl`; +chomp @files; + +printTest "Checking " . (scalar @files) . " files for includes.\n"; + +foreach my $file (@files) { + ok( system("cat $file | grep 'use strict;' >/dev/null") == 0, + "$file use strict" ); + ok( system("cat $file | grep 'use warnings;' >/dev/null") == 0, + "$file use warnings" ); +} + +done_testing(); + +exit(0); diff --git a/vespaclient/src/perl/test/TestUtils/OutputCapturer.pm b/vespaclient/src/perl/test/TestUtils/OutputCapturer.pm new file mode 100644 index 00000000000..cb36807999e --- /dev/null +++ b/vespaclient/src/perl/test/TestUtils/OutputCapturer.pm @@ -0,0 +1,112 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +package TestUtils::OutputCapturer; + +use Test::More; +use Yahoo::Vespa::ConsoleOutput; + +BEGIN { + use base 'Exporter'; + our @EXPORT = qw( + getOutput + isOutput + matchesOutput + ); +} + +Yahoo::Vespa::ConsoleOutput::setTerminalWidth(79); + +our ($stdout, $stderr); +my $USE_COLORS = 1; + +&openStreams(); + +END { + &closeStreams(); +} + +return 1; + +sub useColors { + $USE_COLORS = $_[0]; + &closeStreams(); + &openStreams(); +} + +sub isOutput { # (stdout, stderr, test) + my ($expected_cout, $expected_cerr, $test) = @_; + my ($cout, $cerr) = &getOutput(); + &diff($expected_cout, $cout); + ok ($cout eq $expected_cout, $test . " - stdout"); + &diff($expected_cerr, $cerr); + ok ($cerr eq $expected_cerr, $test . " - stderr"); +} + +sub matchesOutput { # (stdout_pattern, stderr_pattern, test) + my ($cout_pat, $cerr_pat, $test) = @_; + my ($cout, $cerr) = &getOutput(); + if ($cout !~ $cout_pat) { + diag("Output did not match standard out pattern:\n/$cout_pat/:\n$cout"); + } + ok ($cout =~ $cout_pat, $test . " - stdout"); + if ($cerr !~ $cerr_pat) { + diag("Stderr output did not match standard err pattern:\n" + . "/$cerr_pat/:\n$cerr"); + } + ok ($cerr =~ $cerr_pat, $test . " - stdout"); +} + +sub getOutput { + my $cout = &getStdOut(); + my $cerr = &getStdErr(); + &closeStreams(); + &openStreams(); + return ($cout, $cerr); +} + +sub openStreams { + open ($stdout, ">/tmp/vespaclient.perltest.stdout.log") + or die "Failed to create tmp file for stdout"; + open ($stderr, ">/tmp/vespaclient.perltest.stderr.log") + or die "Failed to create tmp file for stdout"; + Yahoo::Vespa::ConsoleOutput::initialize($stdout, $stderr, $USE_COLORS); +} + +sub closeStreams { + close $stdout; + close $stderr; + system("rm /tmp/vespaclient.perltest.stdout.log"); + system("rm /tmp/vespaclient.perltest.stderr.log"); +} + +sub getStdOut { + my $data = `cat /tmp/vespaclient.perltest.stdout.log`; + if (!defined $data) { $data = ''; } + return $data; +} + +sub getStdErr { + my $data = `cat /tmp/vespaclient.perltest.stderr.log`; + if (!defined $data) { $data = ''; } + return $data; +} + +sub diff { + my ($expected, $actual) = @_; + if ($expected eq $actual) { return; } + &writeToFile("/tmp/vespaclient.perltest.expected", $expected); + &writeToFile("/tmp/vespaclient.perltest.actual", $actual); + print "Output differs. Diff:\n"; + system("diff -u /tmp/vespaclient.perltest.expected " + . "/tmp/vespaclient.perltest.actual"); + system("rm -f /tmp/vespaclient.perltest.expected"); + system("rm -f /tmp/vespaclient.perltest.actual"); +} + +sub writeToFile { + my ($file, $data) = @_; + my $fh; + open ($fh, ">$file") or die "Failed to open temp file for writing."; + print $fh $data; + close $fh; +} diff --git a/vespaclient/src/perl/test/TestUtils/VespaTest.pm b/vespaclient/src/perl/test/TestUtils/VespaTest.pm new file mode 100644 index 00000000000..5df153e5938 --- /dev/null +++ b/vespaclient/src/perl/test/TestUtils/VespaTest.pm @@ -0,0 +1,92 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +package TestUtils::VespaTest; + +use Test::More; +use TestUtils::OutputCapturer; +use Yahoo::Vespa::Utils; + +BEGIN { + use base 'Exporter'; + our @EXPORT = qw( + isOutput + matchesOutput + setApplication + assertRun + assertRunMatches + printTest + useColors + setLocalHost + ); +} + +my $APPLICATION; + +&initialize(); + +return 1; + +sub initialize { + Yahoo::Vespa::Utils::initializeUnitTest( + 'testhost.yahoo.com', \&mockedExitHandler); +} + +sub setLocalHost { + my ($host) = @_; + Yahoo::Vespa::Utils::initializeUnitTest( + $host, \&mockedExitHandler); +} + +sub useColors { + TestUtils::OutputCapturer::useColors(@_); +} + +sub mockedExitHandler { + my ($exitcode) = @_; + die "Application exited with exitcode $exitcode."; +} + +sub setApplication { + my ($main_func) = @_; + $APPLICATION = $main_func; +} + +sub assertRun { + my ($testname, $argstring, + $expected_exitcode, $expected_stdout, $expected_stderr) = @_; + my $exitcode = &run($argstring); + is( $exitcode, $expected_exitcode, "$testname - exitcode" ); + # print OutputCapturer::getStdOut(); + isOutput($expected_stdout, $expected_stderr, $testname); +} + +sub assertRunMatches { + my ($testname, $argstring, + $expected_exitcode, $expected_stdout, $expected_stderr) = @_; + my $exitcode = &run($argstring); + is( $exitcode, $expected_exitcode, "$testname - exitcode" ); + # print OutputCapturer::getStdOut(); + matchesOutput($expected_stdout, $expected_stderr, $testname); +} + +sub run { + my ($argstring) = @_; + my @args = split(/\s+/, $argstring); + eval { + Yahoo::Vespa::ArgParser::initialize(); + &$APPLICATION(\@args); + }; + my $exitcode = 0; + if ($@) { + if ($@ =~ /Application exited with exitcode (\d+)\./) { + $exitcode = 1; + } else { + print "Unknown die signal '" . $@ . "'\n"; + } + } + return $exitcode; +} + +sub printTest { + print "Test: ", @_; +} diff --git a/vespaclient/src/perl/test/Yahoo/Vespa/ArgParserTest.pl b/vespaclient/src/perl/test/Yahoo/Vespa/ArgParserTest.pl new file mode 100644 index 00000000000..78924f1bdcc --- /dev/null +++ b/vespaclient/src/perl/test/Yahoo/Vespa/ArgParserTest.pl @@ -0,0 +1,313 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +use Test::More; + +BEGIN { use_ok( 'Yahoo::Vespa::ArgParser' ); } +require_ok( 'Yahoo::Vespa::ArgParser' ); + +BEGIN { *ArgParser:: = *Yahoo::Vespa::ArgParser:: } + +use TestUtils::OutputCapturer; + +TestUtils::OutputCapturer::useColors(1); + +&testSyntaxPage(); + +TestUtils::OutputCapturer::useColors(0); + +&testStringOption(); +&testIntegerOption(); +&testHostOption(); +&testPortOption(); +&testFlagOption(); +&testCountOption(); +&testComplexParsing(); +&testArguments(); + +done_testing(); + +exit(0); + +sub testSyntaxPage { + # Empty + ArgParser::writeSyntaxPage(); + my $expected = <<EOS; +Usage: ArgParserTest.pl +EOS + isOutput($expected, '', 'Empty syntax page'); + + # Built in only + Yahoo::Vespa::ArgParser::registerInternalParameters(); + ArgParser::writeSyntaxPage(); + $expected = <<EOS; +Usage: ArgParserTest.pl [Options] + +Options: + -h --help : Show this help page. + -v : Create more verbose output. + -s : Create less verbose output. + --show-hidden : Also show hidden undocumented debug options. +EOS + isOutput($expected, '', 'Syntax page with default args'); + + # Actual example + ArgParser::initialize(); + + setProgramBinaryName("testprog"); + setProgramDescription( + "This is a multiline description of what the program is that " + . "should be split accordingly to look nice. For now probably hard " + . "coded, but can later be extended to detect terminal width."); + my $arg; + setArgument(\$arg, "Test Arg", "This argument is not used for anything.", + OPTION_REQUIRED); + my $optionalArg; + setArgument(\$arg, "Another Test Arg", + "This argument is not used for anything either."); + + setOptionHeader("My prog headers. Also a long line just to check that it " + . "is also split accordingly."); + my $stringval; + my $flag; + my $intval; + setStringOption(['string', 'j'], \$stringval, "A random string"); + setFlagOption(['flag', 'f'], \$flag, "A flag option with a pretty long " + . "description that might need to be split into multiple lines."); + setOptionHeader("More options"); + setIntegerOption(['integer', 'i'], \$intval, "A secret integer option.", + OPTION_SECRET); + Yahoo::Vespa::ArgParser::registerInternalParameters(); + ArgParser::writeSyntaxPage(); + $expected = <<EOS; +This is a multiline description of what the program is that should be split +accordingly to look nice. For now probably hard coded, but can later be +extended to detect terminal width. + +Usage: testprog [Options] <Test Arg> [Another Test Arg] + +Arguments: + Test Arg : This argument is not used for anything. + Another Test Arg : This argument is not used for anything either. + +Options: + -h --help : Show this help page. + -v : Create more verbose output. + -s : Create less verbose output. + --show-hidden : Also show hidden undocumented debug options. + +My prog headers. Also a long line just to check that it is also split +accordingly. + --string -j : A random string + --flag -f : A flag option with a pretty long description that might need + to be split into multiple lines. +EOS + isOutput($expected, '', 'Actual syntax page example'); + + ArgParser::setShowHidden(1); + ArgParser::writeSyntaxPage(); + $expected = <<EOS; +This is a multiline description of what the program is that should be split +accordingly to look nice. For now probably hard coded, but can later be +extended to detect terminal width. + +Usage: testprog [Options] <Test Arg> [Another Test Arg] + +Arguments: + Test Arg : This argument is not used for anything. + Another Test Arg : This argument is not used for anything either. + +Options: + -h --help : Show this help page. + -v : Create more verbose output. + -s : Create less verbose output. + --show-hidden : Also show hidden undocumented debug options. + +My prog headers. Also a long line just to check that it is also split +accordingly. + --string -j : A random string + --flag -f : A flag option with a pretty long description that might need + to be split into multiple lines. + +More options + --integer -i : A secret integer option. + + --nocolors : Do not use ansi colors in print. +EOS + isOutput($expected, '', 'Actual syntax page example with hidden'); +} + +sub setUpParseTest { + Yahoo::Vespa::ArgParser::initialize(); +} + +sub parseFail { + my ($optstring, $expectedError) = @_; + my @args = split(/\s+/, $optstring); + my $name = $expectedError; + chomp $name; + if (length $name > 40 && $name =~ /^(.{20,70}?)\./) { + $name = $1; + } elsif (length $name > 55 && $name =~ /^(.{40,55})\s/) { + $name = $1; + } + ok( !ArgParser::parseCommandLineArguments(\@args), + "Expected parse failure: $name"); + isOutput('', $expectedError, $name); +} + +sub parseSuccess { + my ($optstring, $testname) = @_; + my @args = split(/\s+/, $optstring); + ok( ArgParser::parseCommandLineArguments(\@args), + "Expected parse success: $testname"); + isOutput('', '', $testname); +} + +sub testStringOption { + &setUpParseTest(); + my $val; + setStringOption(['s'], \$val, 'foo'); + parseFail("-s", "Too few arguments for option 's'\.\n"); + ok( !defined $val, 'String value unset on failure' ); + parseSuccess("-s foo", "String option"); + ok( $val eq 'foo', "String value set" ); +} + +sub testIntegerOption { + &setUpParseTest(); + my $val; + setIntegerOption(['i'], \$val, 'foo'); + parseFail("-i", "Too few arguments for option 'i'\.\n"); + ok( !defined $val, 'Integer value unset on failure' ); + parseFail("-i foo", "Invalid value 'foo' given to integer option 'i'\.\n"); + parseFail("-i 0.5", "Invalid value '0.5' given to integer option 'i'\.\n"); + parseSuccess("-i 5", "Integer option"); + ok( $val == 5, "Integer value set" ); + # Don't allow numbers as first char in id, so this can be detected as + # argument for integer. + parseSuccess("-i -8", "Negative integer option"); + ok( $val == -8, "Integer value set" ); + # Test big numbers + parseSuccess("-i 8000000000", "Big integer option"); + ok( $val / 1000000 == 8000, "Integer value set" ); + parseSuccess("-i -8000000000", "Big negative integer option"); + ok( $val / 1000000 == -8000, "Integer value set" ); +} + +sub testHostOption { + &setUpParseTest(); + my $val; + setHostOption(['h'], \$val, 'foo'); + parseFail("-h", "Too few arguments for option 'h'\.\n"); + ok( !defined $val, 'Host value unset on failure' ); + parseFail("-h 5", "Invalid host '5' given to option 'h'\. Not a valid host\n"); + parseFail("-h non.existing.host.no", "Invalid host 'non.existing.host.no' given to option 'h'\. Not a valid host\n"); + parseSuccess("-h localhost", "Host option set"); + is( $val, 'localhost', 'Host value set' ); +} + +sub testPortOption { + &setUpParseTest(); + my $val; + setPortOption(['p'], \$val, 'foo'); + parseFail("-p", "Too few arguments for option 'p'\.\n"); + ok( !defined $val, 'Host value unset on failure' ); + parseFail("-p -1", "Invalid value '-1' given to port option 'p'\. Must be an unsigned 16 bit\ninteger\.\n"); + parseFail("-p 65536", "Invalid value '65536' given to port option 'p'\. Must be an unsigned 16 bit\ninteger\.\n"); + parseSuccess("-p 65535", "Port option set"); + is( $val, 65535, 'Port value set' ); +} + +sub testFlagOption { + &setUpParseTest(); + my $val; + setFlagOption(['f'], \$val, 'foo'); + setFlagOption(['g'], \$val2, 'foo', OPTION_INVERTEDFLAG); + parseFail("-f 3", "Unhandled argument '3'\.\n"); + parseSuccess("-f", "First flag option set"); + is( $val, 1, 'Flag value set' ); + is( $val2, 1, 'Flag value set' ); + parseSuccess("-f", "First flag option reset"); + is( $val, 1, 'Flag value set' ); + is( $val2, 1, 'Flag value set' ); + parseSuccess("-g", "Second flag option set"); + is( $val, 0, 'Flag value set' ); + is( $val2, 0, 'Flag value set' ); + parseSuccess("-fg", "Both flag options set"); + is( $val, 1, 'Flag value set' ); + is( $val2, 0, 'Flag value set' ); +} + +sub testCountOption { + &setUpParseTest(); + my $val; + setUpCountingOption(['u'], \$val, 'foo'); + setDownCountingOption(['d'], \$val, 'foo'); + parseSuccess("", "Count not set"); + ok( !defined $val, 'Count value not set if not specified' ); + parseSuccess("-u", "Counting undefined"); + is( $val, 1, 'Count value set' ); + parseSuccess("-d", "Counting undefined - down"); + is( $val, -1, 'Count value set' ); + parseSuccess("-uuuud", "Counting both ways"); + is( $val, 3, 'Count value set' ); +} + +sub testComplexParsing { + &setUpParseTest(); + my $count; + my $int; + my $string; + setUpCountingOption(['u', 'up'], \$count, 'foo'); + setIntegerOption(['i', 'integer'], \$int, 'bar'); + setStringOption(['s', 'string'], \$string, 'baz'); + parseSuccess("-uis 3 foo", "Complex parsing managed"); + is( $count, 1, 'count counted' ); + is( $int, 3, 'integer set' ); + is( $string, 'foo', 'string set' ); + parseSuccess("-uiusi 3 foo 5", "Complex parsing managed 2"); + is( $count, 2, 'count counted' ); + is( $int, 5, 'integer set' ); + is( $string, 'foo', 'string set' ); + parseSuccess("-s -i foo -u 3", "Complex parsing managed 3"); + is( $count, 1, 'count counted' ); + is( $int, 3, 'integer set' ); + is( $string, 'foo', 'string set' ); +} + +sub testArguments { + &testOptionalArgument(); + &testRequiredArgument(); + &testRequiredArgumentAfterOptional(); +} + +sub testOptionalArgument { + &setUpParseTest(); + my $val; + setArgument(\$val, "Name", "Description"); + parseSuccess("", "Unset optional argument"); + ok( !defined $val, "Argument unset if not specified" ); + parseSuccess("myval", "Optional argument set"); + is( $val, 'myval', 'Optional argument set to correct value' ); +} + +sub testRequiredArgument { + &setUpParseTest(); + my $val; + setArgument(\$val, "Name", "Description", OPTION_REQUIRED); + parseFail("", "Argument Name is required but not specified\.\n"); + ok( !defined $val, "Argument unset on failure" ); + parseSuccess("myval", "Required argument set"); + is( $val, 'myval', 'Required argument set to correct value' ); +} + +sub testRequiredArgumentAfterOptional { + &setUpParseTest(); + my ($val, $val2); + setArgument(\$val, "Name", "Description"); + eval { + setArgument(\$val2, "Name2", "Description2", OPTION_REQUIRED); + }; + like( $@, qr/Cannot add required argument after optional/, + 'Fails adding required arg after optional' ); +} diff --git a/vespaclient/src/perl/test/Yahoo/Vespa/Bin/GetClusterStateTest.pl b/vespaclient/src/perl/test/Yahoo/Vespa/Bin/GetClusterStateTest.pl new file mode 100644 index 00000000000..3339d872de5 --- /dev/null +++ b/vespaclient/src/perl/test/Yahoo/Vespa/Bin/GetClusterStateTest.pl @@ -0,0 +1,65 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +use Test::More; +use strict; +use warnings; + +BEGIN { use_ok( 'Yahoo::Vespa::Bin::GetClusterState' ); } +require_ok( 'Yahoo::Vespa::Bin::GetClusterState' ); + +use TestUtils::VespaTest; +use Yahoo::Vespa::Mocks::ClusterControllerMock; +use Yahoo::Vespa::Mocks::VespaModelMock; + +# Set which application is called on assertRun / assertRunMatches calls +setApplication( \&getClusterState ); + +useColors(0); + +&testSimple(); +&testSyntaxPage(); +&testClusterDown(); + +done_testing(); + +exit(0); + +sub testSimple { + my $stdout = <<EOS; + +Cluster books: +books/storage/0: down +books/storage/1: up + +Cluster music: +music/distributor/0: down +music/distributor/1: up +music/storage/0: retired +EOS + assertRun("Default - no arguments", "", 0, $stdout, ""); +} + +sub testClusterDown { + Yahoo::Vespa::Mocks::ClusterControllerMock::setClusterDown(); + Yahoo::Vespa::ClusterController::init(); + Yahoo::Vespa::Bin::GetClusterState::init(); + my $stdout = <<EOS; + +Cluster books: +books/storage/0: down +books/storage/1: up + +Cluster music is down. Too few nodes available. +music/distributor/0: down +music/distributor/1: up +music/storage/0: retired +EOS + assertRun("Music cluster down", "", 0, $stdout, ""); +} + +sub testSyntaxPage { + my $stdout = <<EOS; +EOS + my $pat = qr/^Get the cluster state of a given cluster.*Usage:.*GetClusterState.*Options.*--help.*/s; + assertRunMatches("Syntax page", "--help", 1, $pat, qr/^$/); +} diff --git a/vespaclient/src/perl/test/Yahoo/Vespa/Bin/GetNodeStateTest.pl b/vespaclient/src/perl/test/Yahoo/Vespa/Bin/GetNodeStateTest.pl new file mode 100644 index 00000000000..86cff2b28b3 --- /dev/null +++ b/vespaclient/src/perl/test/Yahoo/Vespa/Bin/GetNodeStateTest.pl @@ -0,0 +1,71 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +use Test::More; +use strict; +use warnings; + +BEGIN { use_ok( 'Yahoo::Vespa::Bin::GetNodeState' ); } +require_ok( 'Yahoo::Vespa::Bin::GetNodeState' ); + +use TestUtils::VespaTest; +use Yahoo::Vespa::Mocks::ClusterControllerMock; +use Yahoo::Vespa::Mocks::VespaModelMock; + +useColors(0); + +# Set which application is called on assertRun / assertRunMatches calls +setApplication( \&getNodeState ); + +&testSimple(); +&testSyntaxPage(); +&testRetired(); + +done_testing(); + +exit(0); + +sub testSimple { + my $stdout = <<EOS; +Shows the various states of one or more nodes in a Vespa Storage cluster. There +exist three different type of node states. They are: + + Unit state - The state of the node seen from the cluster controller. + User state - The state we want the node to be in. By default up. Can be + set by administrators or by cluster controller when it + detects nodes that are behaving badly. + Generated state - The state of a given node in the current cluster state. + This is the state all the other nodes know about. This + state is a product of the other two states and cluster + controller logic to keep the cluster stable. + +books/storage.0: +Unit: down: Not in slobrok +Generated: down: Not seen +User: down: default + +music/distributor.0: +Unit: up: Now reporting state U +Generated: down: Setting it down +User: down: Setting it down +EOS + assertRun("Default - no arguments", "", 0, $stdout, ""); +} + +sub testRetired { + setLocalHost("other.host.yahoo.com"); + my $stdout = <<EOS; + +music/storage.0: +Unit: up: Now reporting state U +Generated: retired: Stop using +User: retired: Stop using +EOS + assertRun("Other node", "-c music -t storage -i 0 -s", 0, $stdout, ""); +} + +sub testSyntaxPage { + my $stdout = <<EOS; +EOS + my $pat = qr/^Retrieve the state of one or more.*Usage:.*GetNodeState.*Options.*--help.*/s; + assertRunMatches("Syntax page", "--help", 1, $pat, qr/^$/); +} diff --git a/vespaclient/src/perl/test/Yahoo/Vespa/Bin/SetNodeStateTest.pl b/vespaclient/src/perl/test/Yahoo/Vespa/Bin/SetNodeStateTest.pl new file mode 100644 index 00000000000..1c6f4180dab --- /dev/null +++ b/vespaclient/src/perl/test/Yahoo/Vespa/Bin/SetNodeStateTest.pl @@ -0,0 +1,129 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +use Test::More; +use strict; +use warnings; + +BEGIN { use_ok( 'Yahoo::Vespa::Bin::SetNodeState' ); } +require_ok( 'Yahoo::Vespa::Bin::SetNodeState' ); + +use TestUtils::VespaTest; +use Yahoo::Vespa::Mocks::ClusterControllerMock; +use Yahoo::Vespa::Mocks::VespaModelMock; + +# Set which application is called on assertRun / assertRunMatches calls +setApplication( \&setNodeState ); + +&testSimple(); +&testSyntaxPage(); +&testHelp(); +&testDownState(); +&testDownFailure(); +&testDefaultMaintenanceFails(); +&testForcedMaintenanceSucceeds(); + +done_testing(); + +exit(0); + +sub testSimple { + my $stdout = <<EOS; +Set user state for books/storage/0 to 'up' with reason '' +Set user state for music/distributor/0 to 'up' with reason '' +EOS + assertRun("Default - Min arguments", "up", 0, $stdout, ""); +} + +sub testSyntaxPage { + my $stdout = <<EOS; +EOS + my $pat = qr/^Set the user state of a node.*Usage:.*SetNodeState.*Arguments:.*Options:.*--help.*/s; + assertRunMatches("Syntax page", "--help", 1, $pat, qr/^$/); +} + +sub testHelp { + my $stdout = <<EOS; +Set the user state of a node. This will set the generated state to the user +state if the user state is "better" than the generated state that would have +been created if the user state was up. For instance, a node that is currently +in initializing state can be forced into down state, while a node that is +currently down can not be forced into retired state, but can be forced into +maintenance state. + +Usage: SetNodeStateTest.pl [Options] <Wanted State> [Description] + +Arguments: + Wanted State : User state to set. This must be one of up, down, maintenance or + retired. + Description : Give a reason for why you are altering the user state, which + will show up in various admin tools. (Use double quotes to give + a reason with whitespace in it) + +Options: + -h --help : Show this help page. + -v : Create more verbose output. + -s : Create less verbose output. + --show-hidden : Also show hidden undocumented debug options. + +Node selection options. By default, nodes running locally will be selected: + -c --cluster : Cluster name of cluster to query. If unspecified, + and vespa is installed on current node, information + will be attempted auto-extracted + -f --force : Force the execution of a dangerous command. + -t --type : Node type to query. This can either be 'storage' or + 'distributor'. If not specified, the operation will + show state for all types. + -i --index : The node index to show state for. If not specified, + all nodes found running on this host will be shown. + +Config retrieval options: + --config-server : Host name of config server to query + --config-server-port : Port to connect to config server on + --config-request-timeout : Timeout of config request +EOS + + assertRun("Help text", "-h", 1, $stdout, ""); +} + +sub testDownState { + my $stdout = <<EOS; +Set user state for books/storage/0 to 'down' with reason 'testing' +Set user state for music/distributor/0 to 'down' with reason 'testing' +EOS + assertRun("Down state", "down testing", 0, $stdout, ""); +} + +sub testDownFailure { + $Yahoo::Vespa::Mocks::ClusterControllerMock::forceInternalServerError = 1; + + my $stderr = <<EOS; +Failed to set node state for node books/storage/0: 500 Internal Server Error +(forced) +EOS + + assertRun("Down failure", "--nocolors down testing", 1, "", $stderr); + + $Yahoo::Vespa::Mocks::ClusterControllerMock::forceInternalServerError = 0; +} + +sub testDefaultMaintenanceFails { + my $stderr = <<EOS; +Setting the distributor to maintenance mode may have severe consequences for +feeding! +Please specify -t storage to only set the storage node to maintenance mode, or +-f to override this error. +EOS + + assertRun("Default maintenance fails", "--nocolors maintenance testing", + 1, "", $stderr); +} + +sub testForcedMaintenanceSucceeds { + my $stdout = <<EOS; +Set user state for books/storage/0 to 'maintenance' with reason 'testing' +Set user state for music/distributor/0 to 'maintenance' with reason 'testing' +EOS + + assertRun("Forced maintenance succeeds", "-f maintenance testing", + 0, $stdout, ""); +} diff --git a/vespaclient/src/perl/test/Yahoo/Vespa/ClusterControllerTest.pl b/vespaclient/src/perl/test/Yahoo/Vespa/ClusterControllerTest.pl new file mode 100644 index 00000000000..c70d7287566 --- /dev/null +++ b/vespaclient/src/perl/test/Yahoo/Vespa/ClusterControllerTest.pl @@ -0,0 +1,49 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +use Test::More; +use Data::Dumper; + +BEGIN { use_ok( 'Yahoo::Vespa::ClusterController' ); } +require_ok( 'Yahoo::Vespa::ClusterController' ); + +use TestUtils::OutputCapturer; +use Yahoo::Vespa::Mocks::ClusterControllerMock; +use Yahoo::Vespa::Mocks::VespaModelMock; + +Yahoo::Vespa::ConsoleOutput::setVerbosity(0); # Squelch output when running test +detectClusterController(); +Yahoo::Vespa::ConsoleOutput::setVerbosity(3); + +my $cclist = Yahoo::Vespa::ClusterController::getClusterControllers(); +is( scalar @$cclist, 1, "Cluster controllers detected" ); +is( $$cclist[0]->host, 'testhost.yahoo.com', 'Host autodetected' ); +is( $$cclist[0]->port, 19050, 'Port autodetected' ); + +is( join (' - ', Yahoo::Vespa::ClusterController::listContentClusters()), + "music - books", 'Content clusters' ); + +my $state = getContentClusterState('music'); + +$Data::Dumper::Indent = 1; +# print Dumper($state); + +is( $state->globalState, 'up', 'Generated state for music' ); + +is( $state->distributor->{'0'}->unit->state, 'up', 'Unit state for music' ); +is( $state->distributor->{'1'}->unit->state, 'up', 'Unit state for music' ); +is( $state->storage->{'0'}->unit->state, 'up', 'Unit state for music' ); +is( $state->storage->{'1'}->unit->state, 'up', 'Unit state for music' ); +is( $state->distributor->{'0'}->generated->state, 'down', 'Generated state' ); +is( $state->distributor->{'1'}->generated->state, 'up', 'Generated state' ); +is( $state->storage->{'0'}->generated->state, 'retired', 'Generated state' ); +is( $state->storage->{'1'}->generated->state, 'up', 'Generated state' ); +is( $state->distributor->{'0'}->user->state, 'down', 'User state' ); +is( $state->distributor->{'1'}->user->state, 'up', 'User state' ); +is( $state->storage->{'0'}->user->state, 'retired', 'User state' ); +is( $state->storage->{'1'}->user->state, 'up', 'User state' ); + +is( $state->storage->{'1'}->unit->reason, 'Now reporting state U', 'Reason' ); + +done_testing(); + +exit(0); diff --git a/vespaclient/src/perl/test/Yahoo/Vespa/ConsoleOutputTest.pl b/vespaclient/src/perl/test/Yahoo/Vespa/ConsoleOutputTest.pl new file mode 100644 index 00000000000..bd398a5b9f7 --- /dev/null +++ b/vespaclient/src/perl/test/Yahoo/Vespa/ConsoleOutputTest.pl @@ -0,0 +1,47 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +use Test::More; + +BEGIN { use_ok( 'Yahoo::Vespa::ConsoleOutput' ); } +require_ok( 'Yahoo::Vespa::ConsoleOutput' ); + +ok( Yahoo::Vespa::ConsoleOutput::getVerbosity() == 3, + 'Default verbosity is 3' ); +ok( Yahoo::Vespa::ConsoleOutput::usingAnsiColors(), + 'Using ansi colors by default' ); + +use TestUtils::VespaTest; + +printSpam "test\n"; +isOutput('', '', "No spam at level 3"); + +printDebug "test\n"; +isOutput('', '', "No spam at level 3"); + +printInfo "info test\n"; +isOutput("info test\n", '', "Info at level 3"); + +printWarning "foo\n"; +isOutput("", "\e[93mfoo\e[0m\n", "Stderr output for warning"); + +useColors(0); +printWarning "foo\n"; +isOutput("", "foo\n", "Stderr output without ansi colors"); + +Yahoo::Vespa::ConsoleOutput::setVerbosity(4); +printSpam "test\n"; +isOutput('', '', "No spam at level 4"); + +printDebug "test\n"; +isOutput("debug: test\n", '', "Debug at level 4"); + +Yahoo::Vespa::ConsoleOutput::setVerbosity(5); +printSpam "test\n"; +isOutput("spam: test\n", '', "Spam at level 5"); + +printInfo "info test\n"; +isOutput("info: info test\n", '', "Type prefix at high verbosity"); + +done_testing(); + +exit(0); diff --git a/vespaclient/src/perl/test/Yahoo/Vespa/HttpTest.pl b/vespaclient/src/perl/test/Yahoo/Vespa/HttpTest.pl new file mode 100644 index 00000000000..88c2961e3a2 --- /dev/null +++ b/vespaclient/src/perl/test/Yahoo/Vespa/HttpTest.pl @@ -0,0 +1,140 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# Tests of the Http wrapper library.. +# +# NOTE: Test server set up does not support content not ending in newline. +# + +use strict; +use Test::More; +use Yahoo::Vespa::Mocks::HttpServerMock; + +BEGIN { + use_ok( 'Yahoo::Vespa::Http' ); + *Http:: = *Yahoo::Vespa::Http:: +} +require_ok( 'Yahoo::Vespa::Http' ); + +my $httpTestServerPort = setupTestHttpServer(); +ok(defined $httpTestServerPort, "Test server set up"); + +&testSimpleGet(); +&testAdvancedGet(); +&testFailingGet(); +&testSimplePost(); +&testJsonReturnInPost(); + +done_testing(); + +exit(0); + +sub filterRequest { + my ($request) = @_; + $request =~ s/\r//g; + $request =~ s/(Content-Length:\s*)\d+/$1##/g; + $request =~ s/(Host: localhost:)\d+/$1##/g; + $request =~ s/(?:Connection|TE|Client-[^:]+):[^\n]*\n//g; + + return $request; +} + +sub testSimpleGet { + my %r = Http::get('localhost', $httpTestServerPort, '/foo'); + is( $r{'code'}, 200, "Get request code" ); + is( $r{'status'}, 'OK', "Get request status" ); + + my $expected = <<EOS; +HTTP/1.1 200 OK +Content-Length: ## +Content-Type: text/plain; charset=utf-8 + +GET /foo HTTP/1.1 +Host: localhost:## +User-Agent: Vespa-perl-script +EOS + is( &filterRequest($r{'all'}), $expected, 'Get result' ); +} + +sub testAdvancedGet { + my @headers = ("X-Foo" => 'Bar'); + my @uri_param = ("uricrap" => 'special=?&%value', + "other" => 'hmm'); + my %r = Http::request('GET', 'localhost', $httpTestServerPort, '/foo', + \@uri_param, undef, \@headers); + is( $r{'code'}, 200, "Get request code" ); + is( $r{'status'}, 'OK', "Get request status" ); + + my $expected = <<EOS; +HTTP/1.1 200 OK +Content-Length: ## +Content-Type: text/plain; charset=utf-8 + +GET /foo?uricrap=special%3D%3F%26%25value&other=hmm HTTP/1.1 +Host: localhost:## +User-Agent: Vespa-perl-script +X-Foo: Bar +EOS + is( &filterRequest($r{'all'}), $expected, 'Get result' ); +} + +sub testFailingGet { + my @uri_param = ("code" => '501', + "status" => 'Works'); + my %r = Http::request('GET', 'localhost', $httpTestServerPort, '/foo', + \@uri_param); + is( $r{'code'}, 501, "Get request code" ); + is( $r{'status'}, 'Works', "Get request status" ); + + my $expected = <<EOS; +HTTP/1.1 501 Works +Content-Length: ## +Content-Type: text/plain; charset=utf-8 + +GET /foo?code=501&status=Works HTTP/1.1 +Host: localhost:## +User-Agent: Vespa-perl-script +EOS + is( &filterRequest($r{'all'}), $expected, 'Get result' ); +} + +sub testSimplePost { + my @uri_param = ("uricrap" => 'Rrr' ); + my %r = Http::request('POST', 'localhost', $httpTestServerPort, '/foo', + \@uri_param, "Some content\n"); + is( $r{'code'}, 200, "Get request code" ); + is( $r{'status'}, 'OK', "Get request status" ); + + my $expected = <<EOS; +HTTP/1.1 200 OK +Content-Length: ## +Content-Type: text/plain; charset=utf-8 + +POST /foo?uricrap=Rrr HTTP/1.1 +Host: localhost:## +User-Agent: Vespa-perl-script +Content-Length: ## +Content-Type: application/x-www-form-urlencoded + +Some content +EOS + is( &filterRequest($r{'all'}), $expected, 'Get result' ); +} + +sub testJsonReturnInPost +{ + my @uri_param = ("contenttype" => 'application/json' ); + my $json = "{ \"key\" : \"value\" }\n"; + my %r = Http::request('POST', 'localhost', $httpTestServerPort, '/foo', + \@uri_param, $json); + is( $r{'code'}, 200, "Get request code" ); + is( $r{'status'}, 'OK', "Get request status" ); + + my $expected = <<EOS; +HTTP/1.1 200 OK +Content-Length: ## +Content-Type: application/json + +{ "key" : "value" } +EOS + is( &filterRequest($r{'all'}), $expected, 'Get json result' ); +} diff --git a/vespaclient/src/perl/test/Yahoo/Vespa/JsonTest.pl b/vespaclient/src/perl/test/Yahoo/Vespa/JsonTest.pl new file mode 100644 index 00000000000..5da8ad0e270 --- /dev/null +++ b/vespaclient/src/perl/test/Yahoo/Vespa/JsonTest.pl @@ -0,0 +1,67 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# Tests of the Json wrapper library.. +# + +use Test::More; + +use strict; + +BEGIN { + use_ok( 'Yahoo::Vespa::Json' ); + *Json:: = *Yahoo::Vespa::Json:: # Alias namespace +} +require_ok( 'Yahoo::Vespa::Json' ); + +&testSimpleJson(); + +done_testing(); + +exit(0); + +sub testSimpleJson { + my $json = <<EOS; +{ + "foo" : "bar", + "map" : { + "abc" : "def", + "num" : 13.0 + }, + "array" : [ + { "val1" : 3 }, + { "val2" : 6 } + ] +} +EOS + my $parsed = Json::parse($json); + is( $parsed->{'foo'}, 'bar', 'json test 1' ); + is( $parsed->{'map'}->{'abc'}, 'def', 'json test 2' ); + is( $parsed->{'map'}->{'num'}, 13.0, 'json test 3' ); + my $prettyPrint = <<EOS; +{ + "array" : [ + { + "val1" : 3 + }, + { + "val2" : 6 + } + ], + "map" : { + "num" : 13, + "abc" : "def" + }, + "foo" : "bar" +} +EOS + is( Json::encode($parsed), $prettyPrint, 'simple json test - encode' ); + my @keys = sort keys %{$parsed->{'map'}}; + is( scalar @keys, 2, 'simple json test - map keys' ); + is( $keys[0], 'abc', 'simple json test - map key 1' ); + is( $keys[1], 'num', 'simple json test - map key 2' ); + + @keys = @{ $parsed->{'array'} }; + is( scalar @keys, 2, 'simple json test - list keys' ); + is( $keys[0]->{'val1'}, 3, 'simple json test - list key 1' ); + is( $keys[1]->{'val2'}, 6, 'simple json test - list key 2' ); +} diff --git a/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/ClusterControllerMock.pm b/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/ClusterControllerMock.pm new file mode 100644 index 00000000000..661d8a5e051 --- /dev/null +++ b/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/ClusterControllerMock.pm @@ -0,0 +1,258 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +package Yahoo::Vespa::Mocks::ClusterControllerMock; + +use strict; +use warnings; +use URI::Escape; +use Yahoo::Vespa::ConsoleOutput; +use Yahoo::Vespa::Mocks::HttpClientMock; +use Yahoo::Vespa::Utils; + +BEGIN { + use base 'Exporter'; + our @EXPORT = qw( + ); +} + +our $forceInternalServerError = 0; + +# Register a handler in the Http Client mock +registerHttpClientHandler(\&handleCCRequest); + +our $clusterListJson = <<EOS; +{ + "cluster" : { + "books" : { + "link" : "/cluster/v2/books" + }, + "music" : { + "link" : "/cluster/v2/music" + } + } +} +EOS +our $musicClusterJson = <<EOS; +{ + "state" : { + "generated" : { + "state" : "up", + "reason" : "" + } + }, + "service" : { + "distributor" : { + "node" : { + "0" : { + "attributes" : { "hierarchical-group" : "top" }, + "state" : { + "generated" : { "state" : "down", "reason" : "Setting it down" }, + "unit" : { "state" : "up", "reason" : "Now reporting state U" }, + "user" : { "state" : "down", "reason" : "Setting it down" } + } + }, + "1" : { + "attributes" : { "hierarchical-group" : "top" }, + "state" : { + "generated" : { "state" : "up", "reason" : "Setting it up" }, + "unit" : { "state" : "up", "reason" : "Now reporting state U" }, + "user" : { "state" : "up", "reason" : "" + } + } + } + } + }, + "storage" : { + "node" : { + "0" : { + "attributes" : { "hierarchical-group" : "top" }, + "state" : { + "generated" : { "state" : "retired", "reason" : "Stop using" }, + "unit" : { "state" : "up", "reason" : "Now reporting state U" }, + "user" : { "state" : "retired", "reason" : "Stop using" } + }, + "partition" : { + "0" : { + "metrics" : { + "bucket-count" : 5, + "unique-document-count" : 10, + "unique-document-total-size" : 1000 + } + } + } + }, + "1" : { + "attributes" : { "hierarchical-group" : "top" }, + "state" : { + "generated" : { "state" : "up", "reason" : "Setting it up" }, + "unit" : { "state" : "up", "reason" : "Now reporting state U" }, + "user" : { "state" : "up", "reason" : "" + } + }, + "partition" : { + "0" : { + "metrics" : { + "bucket-count" : 50, + "unique-document-count" : 100, + "unique-document-total-size" : 10000 + } + } + } + } + } + } + } +} +EOS +our $booksClusterJson = <<EOS; +{ + "state" : { + "generated" : { + "state" : "up", + "reason" : "" + } + }, + "service" : { + "distributor" : { + "node" : { + "0" : { + "attributes" : { "hierarchical-group" : "top.g1" }, + "state" : { + "generated" : { "state" : "down", "reason" : "Setting it down" }, + "unit" : { "state" : "up", "reason" : "Now reporting state U" }, + "user" : { "state" : "down", "reason" : "Setting it down" } + } + }, + "1" : { + "attributes" : { "hierarchical-group" : "top.g2" }, + "state" : { + "generated" : { "state" : "up", "reason" : "Setting it up" }, + "unit" : { "state" : "up", "reason" : "Now reporting state U" }, + "user" : { "state" : "up", "reason" : "" + } + } + } + } + }, + "storage" : { + "node" : { + "0" : { + "attributes" : { "hierarchical-group" : "top.g1" }, + "state" : { + "generated" : { "state" : "down", "reason" : "Not seen" }, + "unit" : { "state" : "down", "reason" : "Not in slobrok" }, + "user" : { "state" : "down", "reason" : "default" } + } + }, + "1" : { + "attributes" : { "hierarchical-group" : "top.g2" }, + "state" : { + "generated" : { "state" : "up", "reason" : "Setting it up" }, + "unit" : { "state" : "up", "reason" : "Now reporting state U" }, + "user" : { "state" : "up", "reason" : "" + } + } + } + } + } + } +} +EOS + +return &init(); + +sub init { + #print "Verifying that cluster list json is parsable.\n"; + my $json = Json::parse($clusterListJson); + #print "Verifying that music json is parsable\n"; + $json = Json::parse($musicClusterJson); + #print "Verifying that books json is parsable\n"; + $json = Json::parse($booksClusterJson); + #print "All seems parsable.\n"; + return 1; +} + +sub setClusterDown { + $musicClusterJson =~ s/"up"/"down"/; + $musicClusterJson =~ s/""/"Not enough nodes up"/; + #print "Cluster state: $musicClusterJson\n"; + #print "Verifying that music json is parsable\n"; + my $json = Json::parse($musicClusterJson); +} + +sub handleCCRequest { # (Type, Host, Port, Path, ParameterMap, Content, Headers) + my ($type, $host, $port, $path, $params, $content, $headers) = @_; + my %paramHash; + if (defined $params) { + %paramHash = @$params; + } + if ($forceInternalServerError) { + printDebug "Forcing internal server error response\n"; + return ( + 'code' => 500, + 'status' => 'Internal Server Error (forced)' + ); + } + if ($path eq "/cluster/v2/") { + printDebug "Handling cluster list request\n"; + return ( + 'code' => 200, + 'status' => 'OK', + 'content' => $clusterListJson + ); + } + if ($path eq "/cluster/v2/music/" + && (exists $paramHash{'recursive'} + && $paramHash{'recursive'} eq 'true')) + { + printDebug "Handling cluster music state request\n"; + return ( + 'code' => 200, + 'status' => 'OK', + 'content' => $musicClusterJson + ); + } + if ($path eq "/cluster/v2/books/" + && (exists $paramHash{'recursive'} + && $paramHash{'recursive'} eq 'true')) + { + printDebug "Handling cluster books state request\n"; + return ( + 'code' => 200, + 'status' => 'OK', + 'content' => $booksClusterJson + ); + } + if ($path =~ /^\/cluster\/v2\/(books|music)\/(storage|distributor)\/(\d+)$/) + { + my ($cluster, $service, $index) = ($1, $2, $3); + my $json = Json::parse($content); + my $state = $json->{'state'}->{'user'}->{'state'}; + my $description = $json->{'state'}->{'user'}->{'reason'}; + if (!defined $description && $state eq 'up') { + $description = ""; + } + if ($state !~ /^(?:up|down|maintenance|retired)$/) { + return ( + 'code' => 500, + 'status' => "Unknown state '$state' specified" + ); + } + if (!defined $state || !defined $description) { + return ( + 'code' => 500, + 'status' => "Invalid form data or failed parsing: '$content'" + ); + } + printDebug "Handling set user state request $cluster/$service/$index"; + return ( + 'code' => 200, + 'status' => "Set user state for $cluster/$service/$index to " + . "'$state' with reason '$description'" + ); + } + printDebug "Request to '$path' not matched. Params:\n"; + foreach my $key (keys %paramHash) { + printDebug " $key => '$paramHash{$key}'\n"; + } + return; +} diff --git a/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/HttpClientMock.pm b/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/HttpClientMock.pm new file mode 100644 index 00000000000..22a15de28b7 --- /dev/null +++ b/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/HttpClientMock.pm @@ -0,0 +1,55 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# Switched the backend implementation of the Vespa::Http library, such that +# requests are sent here rather than onto the network. Register handlers here +# to respond to requests. +# +# Handlers are called in sequence until one of them returns a defined result. +# If none do, return a generic failure. +# + +package Yahoo::Vespa::Mocks::HttpClientMock; + +use strict; +use warnings; +use Yahoo::Vespa::ConsoleOutput; +use Yahoo::Vespa::Http; + +BEGIN { # - Define default exports for module + use base 'Exporter'; + our @EXPORT = qw( + registerHttpClientHandler + ); +} + +my @HANDLERS; + +&initialize(); + +return 1; + +#################### Default exported functions ############################# + +sub registerHttpClientHandler { # (Handler) + push @HANDLERS, $_[0]; +} + +##################### Internal utility functions ########################## + +sub initialize { # () + Yahoo::Vespa::Http::setHttpExecutor(\&clientMock); +} +sub clientMock { # (HttpRequest to forward) -> Response + foreach my $handler (@HANDLERS) { + my %result = &$handler(@_); + if (exists $result{'code'}) { + return %result; + } + } + return ( + 'code' => 500, + 'status' => 'No client handler for given request', + 'content' => '', + 'all' => '' + ); +} diff --git a/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/HttpServerMock.pm b/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/HttpServerMock.pm new file mode 100644 index 00000000000..267a905b67d --- /dev/null +++ b/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/HttpServerMock.pm @@ -0,0 +1,156 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. +# +# A mock of an HTTP server, such that HTTP client library can be tested. +# +# Known limitations: +# - Does line by line reading of TCP data, so the content part of the HTML +# request has to end in a newline, otherwise, the server will block waiting +# for more data. +# +# Default connection handler: +# - If no special case, server returns request 200 OK, with the complete +# client request as text/plain utf8 content. +# - If request matches contenttype=\S+ (Typically due to setting a URI +# parameter), the response will contain the content of the request with the +# given content type set. +# - If request matches code=\d+ (Typically due to setting a URI parameter), +# the response will use that return code. +# - If request matches status=\S+ (Typically due to setting a URI parameter), +# the response will use that status line +# + +package Yahoo::Vespa::Mocks::HttpServerMock; + +use strict; +use warnings; +use IO::Socket::IP; +use URI::Escape; + +BEGIN { # - Set up exports for module + use base 'Exporter'; + our @EXPORT = qw( + setupTestHttpServer + ); +} + +my $HTTP_TEST_SERVER; +my $HTTP_TEST_SERVER_PORT; +my $HTTP_TEST_SERVER_PID; +my $CONNECTION_HANDLER = \&defaultConnectionHandler; + +END { # - Kill forked HTTP handler process on exit + if (defined $HTTP_TEST_SERVER_PID) { + kill(9, $HTTP_TEST_SERVER_PID); + } +} + +return 1; + +####################### Default exported functions ############################ + +sub setupTestHttpServer { # () -> HttpServerPort + my $portfile = "/tmp/vespaclient.$$.perl.httptestserverport"; + unlink($portfile); + my $pid = fork(); + if ($pid == 0) { + $HTTP_TEST_SERVER = IO::Socket::IP->new( + 'Proto' => 'tcp', + 'LocalPort' => 0, + 'Listen' => SOMAXCONN, + 'ReuseAddr' => 1, + ); + # print "Started server listening to port " . $HTTP_TEST_SERVER->sockport() + # . "\n"; + my $fh; + open ($fh, ">$portfile") or die "Failed to write port used to file."; + print $fh "<" . $HTTP_TEST_SERVER->sockport() . ">"; + close $fh; + defined $HTTP_TEST_SERVER or die "Failed to set up test HTTP server"; + while (1) { + &$CONNECTION_HANDLER(); + } + exit(0); + } else { + $HTTP_TEST_SERVER_PID = $pid; + while (1) { + if (-e $portfile) { + my $port = `cat $portfile`; + chomp $port; + if (defined $port && $port =~ /\<(\d+)\>/) { + #print "Client using port $1\n"; + $HTTP_TEST_SERVER_PORT = $1; + last; + } + } + sleep(0.01); + } + } + unlink($portfile); + return $HTTP_TEST_SERVER_PORT; +} + +####################### Internal utility functions ############################ + +sub defaultConnectionHandler { + my $client = $HTTP_TEST_SERVER->accept(); + defined $client or die "No connection to accept?"; + my $request; + my $line; + my $content_length = 0; + my $content_type; + while ($line = <$client>) { + if ($line =~ /^(.*?)\s$/) { + $line = $1; + } + if ($line =~ /Content-Length:\s(\d+)/) { + $content_length = $1; + } + if ($line =~ /contenttype=(\S+)/) { + $content_type = uri_unescape($1); + } + #print "Got line '$line'\n"; + if ($line eq '') { + last; + } + $request .= $line . "\n"; + } + if ($content_length > 0) { + $request .= "\n"; + if (defined $content_type) { + $request = ""; + } + my $read = 0; + while ($line = <$client>) { + $read += length $line; + if ($line =~ /^(.*?)\s$/) { + $line = $1; + } + $request .= $line; + if ($read >= $content_length) { + last; + } + } + } + # print "Got request '$request'.\n"; + $request =~ s/\n/\r\n/g; + my $code = 200; + my $status = "OK"; + if ($request =~ /code=(\d+)/) { + $code = $1; + } + if ($request =~ /status=([A-Za-z0-9]+)/) { + $status = $1; + } + my $response = "HTTP/1.1 $code $status\n"; + if (defined $content_type) { + $response .= "Content-Type: $content_type\n"; + } else { + $response .= "Content-Type: text/plain; charset=utf-8\n"; + } + $response .= "Content-Length: " . (length $request) . "\n" + . "\n"; + $response =~ s/\n/\r\n/g; + $response .= $request; + print $client $response; + close $client; +} diff --git a/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/VespaModelMock.pm b/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/VespaModelMock.pm new file mode 100644 index 00000000000..78bce3f1e6c --- /dev/null +++ b/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/VespaModelMock.pm @@ -0,0 +1,96 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +package Yahoo::Vespa::Mocks::VespaModelMock; + +use strict; +use warnings; +use Yahoo::Vespa::VespaModel; + +Yahoo::Vespa::VespaModel::setModelRetrievalFunction(\&getModelConfig); + +our $defaultModelConfig = <<EOS; +hosts[0].name "testhost.yahoo.com" +hosts[0].services[0].name "container-clustercontroller" +hosts[0].services[0].type "container-clustercontroller" +hosts[0].services[0].configid "admin/cluster-controllers/0" +hosts[0].services[0].clustertype "" +hosts[0].services[0].clustername "cluster-controllers" +hosts[0].services[0].index 0 +hosts[0].services[0].ports[0].number 19050 +hosts[0].services[0].ports[0].tags "state external query http" +hosts[0].services[0].ports[1].number 19100 +hosts[0].services[0].ports[1].tags "external http" +hosts[0].services[0].ports[2].number 19101 +hosts[0].services[0].ports[2].tags "messaging rpc" +hosts[0].services[0].ports[3].number 19102 +hosts[0].services[0].ports[3].tags "admin rpc" +hosts[0].services[1].name "distributor2" +hosts[0].services[1].type "distributor" +hosts[0].services[1].configid "music/distributor/0" +hosts[0].services[1].clustertype "content" +hosts[0].services[1].clustername "music" +hosts[0].services[1].index 0 +hosts[0].services[1].ports[0].number 19131 +hosts[0].services[1].ports[0].tags "messaging" +hosts[0].services[1].ports[1].number 19132 +hosts[0].services[1].ports[1].tags "status rpc" +hosts[0].services[1].ports[2].number 19133 +hosts[0].services[1].ports[2].tags "status http" +hosts[0].services[2].name "storagenode3" +hosts[0].services[2].type "storagenode" +hosts[0].services[2].configid "storage/storage/0" +hosts[0].services[2].clustertype "content" +hosts[0].services[2].clustername "books" +hosts[0].services[2].index 0 +hosts[0].services[2].ports[0].number 19134 +hosts[0].services[2].ports[0].tags "messaging" +hosts[0].services[2].ports[1].number 19135 +hosts[0].services[2].ports[1].tags "status rpc" +hosts[0].services[2].ports[2].number 19136 +hosts[0].services[2].ports[2].tags "status http" +hosts[1].name "other.host.yahoo.com" +hosts[1].services[0].name "distributor2" +hosts[1].services[0].type "distributor" +hosts[1].services[0].configid "music/distributor/1" +hosts[1].services[0].clustertype "content" +hosts[1].services[0].clustername "music" +hosts[1].services[0].index 1 +hosts[1].services[0].ports[0].number 19131 +hosts[1].services[0].ports[0].tags "messaging" +hosts[1].services[0].ports[1].number 19132 +hosts[1].services[0].ports[1].tags "status rpc" +hosts[1].services[0].ports[2].number 19133 +hosts[1].services[0].ports[2].tags "status http" +hosts[1].services[1].name "storagenode3" +hosts[1].services[1].type "storagenode" +hosts[1].services[1].configid "storage/storage/1" +hosts[1].services[1].clustertype "content" +hosts[1].services[1].clustername "books" +hosts[1].services[1].index 1 +hosts[1].services[1].ports[0].number 19134 +hosts[1].services[1].ports[0].tags "messaging" +hosts[1].services[1].ports[1].number 19135 +hosts[1].services[1].ports[1].tags "status rpc" +hosts[1].services[1].ports[2].number 19136 +hosts[1].services[1].ports[2].tags "status http" +hosts[1].services[2].name "storagenode2" +hosts[1].services[2].type "storagenode" +hosts[1].services[2].configid "storage/storage/0" +hosts[1].services[2].clustertype "content" +hosts[1].services[2].clustername "music" +hosts[1].services[2].index 0 +hosts[1].services[2].ports[0].number 19134 +hosts[1].services[2].ports[0].tags "messaging" +hosts[1].services[2].ports[1].number 19135 +hosts[1].services[2].ports[1].tags "status rpc" +hosts[1].services[2].ports[2].number 19136 +hosts[1].services[2].ports[2].tags "status http" + +EOS + +sub getModelConfig { + my @output = split(/\n/, $defaultModelConfig); + return @output; +} + +1; diff --git a/vespaclient/src/perl/test/Yahoo/Vespa/VespaModelTest.pl b/vespaclient/src/perl/test/Yahoo/Vespa/VespaModelTest.pl new file mode 100644 index 00000000000..fdb6a85bb16 --- /dev/null +++ b/vespaclient/src/perl/test/Yahoo/Vespa/VespaModelTest.pl @@ -0,0 +1,63 @@ +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +use Test::More; +use Yahoo::Vespa::Mocks::VespaModelMock; + +BEGIN { + use_ok( 'Yahoo::Vespa::VespaModel' ); + *VespaModel:: = *Yahoo::Vespa::VespaModel:: ; +} +require_ok( 'Yahoo::Vespa::VespaModel' ); + +&testGetSocketForService(); +&testVisitServices(); + +done_testing(); + +exit(0); + +sub testGetSocketForService { + my $sockets = VespaModel::getSocketForService( + type => 'container-clustercontroller', tag => 'state'); + my ($host, $port) = ($$sockets[0]->{'host'}, $$sockets[0]->{'port'}); + is( $host, 'testhost.yahoo.com', "Host for state API" ); + is( $port, 19050, 'Port for state API' ); + $sockets = VespaModel::getSocketForService( + type => 'container-clustercontroller', tag => 'admin'); + ($host, $port) = ($$sockets[0]->{'host'}, $$sockets[0]->{'port'}); + is( $host, 'testhost.yahoo.com', "Host for state API" ); + is( $port, 19102, 'Port for state API' ); + $sockets = VespaModel::getSocketForService( + type => 'container-clustercontroller', tag => 'http'); + ($host, $port) = ($$sockets[0]->{'host'}, $$sockets[0]->{'port'}); + is( $port, 19100, 'Port for state API' ); + + $sockets = VespaModel::getSocketForService( + type => 'distributor', index => 0); + ($host, $port) = ($$sockets[0]->{'host'}, $$sockets[0]->{'port'}); + is( $host, 'testhost.yahoo.com', 'host for distributor 0' ); +} + +my @services; + +sub serviceCallback { + my ($info) = @_; + push @services, "Name($$info{'name'}) Type($$info{'type'}) " + . "Cluster($$info{'cluster'}) Host($$info{'host'}) " + . "Index($$info{'index'})"; +} + +sub testVisitServices { + @services = (); + VespaModel::visitServices(\&serviceCallback); + my $expected = <<EOS; +Name(storagenode3) Type(storagenode) Cluster(books) Host(testhost.yahoo.com) Index(0) +Name(storagenode3) Type(storagenode) Cluster(books) Host(other.host.yahoo.com) Index(1) +Name(container-clustercontroller) Type(container-clustercontroller) Cluster(cluster-controllers) Host(testhost.yahoo.com) Index(0) +Name(distributor2) Type(distributor) Cluster(music) Host(testhost.yahoo.com) Index(0) +Name(distributor2) Type(distributor) Cluster(music) Host(other.host.yahoo.com) Index(1) +Name(storagenode2) Type(storagenode) Cluster(music) Host(other.host.yahoo.com) Index(0) +EOS + chomp $expected; + is ( join("\n", @services), $expected, "Services visited correctly" ); +} diff --git a/vespaclient/src/perl/test/testrunner.pl b/vespaclient/src/perl/test/testrunner.pl new file mode 100644 index 00000000000..c5307671b1a --- /dev/null +++ b/vespaclient/src/perl/test/testrunner.pl @@ -0,0 +1,110 @@ +#!/usr/bin/perl -w +# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. + +# +# Searches around in test dir to find test binaries and run them. Sadly these +# seem to return exit code 0 on some failures for unknown reasons. To counter +# that the testrunner grabs the output of the test and triggers test to fail if +# it finds unexpected data in the output. +# +# Unit tests should mostly not write as this will clutter report, but if they +# want to write some status they have to write it so it does not trigger +# failure here. Use printTest in VespaTest suite to prefix all test output to +# something we match here. +# + +use strict; +use warnings; + +$| = 1; +my @files = `find . -name \*Test.pl`; +chomp @files; + +my $tempdir = `mktemp -d /tmp/mockup-vespahome-XXXXXX`; +chomp $tempdir; +$ENV{'VESPA_HOME'} = $tempdir . "/"; +mkdir "${tempdir}/libexec"; +mkdir "${tempdir}/libexec/vespa" or die "Cannot mkdir ${tempdir}/libexec/vespa\n"; +`touch ${tempdir}/libexec/vespa/common-env.sh`; + +my $pat; +if (exists $ENV{'TEST_SUBSET'}) { + $pat = $ENV{'TEST_SUBSET'}; +} + +my $failure_pattern = qr/(?:Tests were run but no plan was declared and done_testing\(\) was not seen)/; +my $accepted_pattern = qr/^(?:\s*|\d+\.\.\d+|ok\s+\d+\s+-\s+.*|Test: .*|.*spam: .*)$/; + +my $failures = 0; +foreach my $file (@files) { + $file =~ /^(?:\.\/)?(.*)\.pl$/ or die "Strange file name '$file'."; + my $test = $1; + if (!defined $pat || $test =~ /$pat/) { + print "\nRunning test suite $test.\n\n"; + my ($code, $result) = captureCommand("PERLLIB=../lib perl -w $file"); + my @data = split(/\n/, $result); + if ($code != 0) { + ++$failures; + print "Test binary returned with non-null exitcode. Failure.\n"; + } elsif (&matchesFailurePattern(\@data)) { + ++$failures; + } elsif (¬MatchesSuccessPattern(\@data)) { + ++$failures; + } + } else { + # print "Skipping test suite '$test' not matching '$pat'.\n"; + } +} + +if ($failures > 0) { + print "\n\n$failures test suites failed.\n"; + exit(1); +} else { + print "\n\nAll tests succeeded.\n"; +} + +`rm -rv ${tempdir}`; + +exit(0); + +sub matchesFailurePattern { # (LineArrayRef) + my ($data) = @_; + foreach my $line (@$data) { + if ($line =~ $failure_pattern) { + print "Line '$line' indicates failure. Failing test suite.\n"; + return 1; + } + } + return 0; +} + +sub notMatchesSuccessPattern { # (LineArrayRef) + my ($data) = @_; + foreach my $line (@$data) { + if ($line !~ $accepted_pattern) { + print "Suspicious line '$line'.\n"; + print "Failing test due to line suspected to indicate failure.\n" + . "(Use printTest to print debug data during test to have it " + . "not been marked suspected.\n"; + return 1; + } + } + return 0; +} + +# Run a given command, giving exitcode and output back, but let command write +# directly to stdout/stderr. (Useful for long running commands or commands that +# may stall, such that you can see where it got into trouble) +sub captureCommand { # (Cmd) -> (ExitCode, Output) + my ($cmd) = @_; + my ($fh, $line); + my $data; + open ($fh, "$cmd 2>&1 |") or die "Failed to run '$cmd'."; + while ($line = <$fh>) { + print $line; + $data .= $line; + } + close $fh; + my $exitcode = $?; + return ($exitcode >> 8, $data); +} |