diff options
Diffstat (limited to 'vespaclient/src/perl')
33 files changed, 0 insertions, 5029 deletions
diff --git a/vespaclient/src/perl/PERL_BEST_PRACTISES b/vespaclient/src/perl/PERL_BEST_PRACTISES deleted file mode 100644 index 29bbc3f01bf..00000000000 --- a/vespaclient/src/perl/PERL_BEST_PRACTISES +++ /dev/null @@ -1,361 +0,0 @@ -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 deleted file mode 100755 index c462eb77ade..00000000000 --- a/vespaclient/src/perl/bin/GetClusterState.pl +++ /dev/null @@ -1,90 +0,0 @@ -#!/usr/bin/env perl -# Copyright Yahoo. 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 - my $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"; -} - -sub findhost { - my $tmp = $ENV{'VESPA_HOSTNAME'}; - my $bin = $ENV{'VESPA_HOME'} . "/bin"; - if (!defined $tmp) { - $tmp = `${bin}/vespa-detect-hostname || hostname -f || hostname || echo "localhost"`; - chomp $tmp; - } - my $validate = "${bin}/vespa-validate-hostname"; - if (-f "${validate}") { - system("${validate} $tmp"); - ( $? == 0 ) or die "Could not validate hostname\n"; - } - return $tmp; -} - -BEGIN { - my $tmp = findhome(); - $ENV{'VESPA_HOME'} = $tmp; - $tmp = findhost(); - $ENV{'VESPA_HOSTNAME'} = $tmp; -} -my $VESPA_HOME = $ENV{'VESPA_HOME'}; - -use lib $ENV{'VESPA_HOME'} . "/lib/perl5/site_perl"; - -# END perl environment bootstrap section - -use Yahoo::Vespa::Defaults; -readConfFile(); - -use strict; -use warnings; - -use Yahoo::Vespa::Bin::GetClusterState; - -exit(getClusterState(\@ARGV)); diff --git a/vespaclient/src/perl/bin/GetNodeState.pl b/vespaclient/src/perl/bin/GetNodeState.pl deleted file mode 100755 index 03947e22199..00000000000 --- a/vespaclient/src/perl/bin/GetNodeState.pl +++ /dev/null @@ -1,90 +0,0 @@ -#!/usr/bin/env perl -# Copyright Yahoo. 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 - my $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"; -} - -sub findhost { - my $tmp = $ENV{'VESPA_HOSTNAME'}; - my $bin = $ENV{'VESPA_HOME'} . "/bin"; - if (!defined $tmp) { - $tmp = `${bin}/vespa-detect-hostname || hostname -f || hostname || echo "localhost"`; - chomp $tmp; - } - my $validate = "${bin}/vespa-validate-hostname"; - if (-f "${validate}") { - system("${validate} $tmp"); - ( $? == 0 ) or die "Could not validate hostname\n"; - } - return $tmp; -} - -BEGIN { - my $tmp = findhome(); - $ENV{'VESPA_HOME'} = $tmp; - $tmp = findhost(); - $ENV{'VESPA_HOSTNAME'} = $tmp; -} -my $VESPA_HOME = $ENV{'VESPA_HOME'}; - -use lib $ENV{'VESPA_HOME'} . "/lib/perl5/site_perl"; - -# END perl environment bootstrap section - -use Yahoo::Vespa::Defaults; -readConfFile(); - -use strict; -use warnings; - -use Yahoo::Vespa::Bin::GetNodeState; - -exit(getNodeState(\@ARGV)); diff --git a/vespaclient/src/perl/bin/SetNodeState.pl b/vespaclient/src/perl/bin/SetNodeState.pl deleted file mode 100755 index 4375aa96112..00000000000 --- a/vespaclient/src/perl/bin/SetNodeState.pl +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/bin/env perl -# Copyright Yahoo. 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 - my $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"; -} - -sub findhost { - my $tmp = $ENV{'VESPA_HOSTNAME'}; - my $bin = $ENV{'VESPA_HOME'} . "/bin"; - if (!defined $tmp) { - $tmp = `${bin}/vespa-detect-hostname || hostname -f || hostname || echo "localhost"`; - chomp $tmp; - } - my $validate = "${bin}/vespa-validate-hostname"; - if (-f "${validate}") { - system("${validate} $tmp"); - ( $? == 0 ) or die "Could not validate hostname\n"; - } - return $tmp; -} - -BEGIN { - my $tmp = findhome(); - $ENV{'VESPA_HOME'} = $tmp; - $tmp = findhost(); - $ENV{'VESPA_HOSTNAME'} = $tmp; -} -my $VESPA_HOME = $ENV{'VESPA_HOME'}; - -use lib $ENV{'VESPA_HOME'} . "/lib/perl5/site_perl"; - -# END perl environment bootstrap section - -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 deleted file mode 100644 index 5abcd0b1fbb..00000000000 --- a/vespaclient/src/perl/lib/Yahoo/Vespa/ArgParser.pm +++ /dev/null @@ -1,689 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index afb36a418ae..00000000000 --- a/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetClusterState.pm +++ /dev/null @@ -1,124 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 35b3f49649e..00000000000 --- a/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetNodeState.pm +++ /dev/null @@ -1,119 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index b1daebff03c..00000000000 --- a/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/SetNodeState.pm +++ /dev/null @@ -1,127 +0,0 @@ -# Copyright Yahoo. 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; -our $no_wait; -our $safe_mode; - -return 1; - -# Run the set node state tool -sub setNodeState { # (Command line arguments) - my ($argsref) = @_; - &handleCommandLine($argsref); - detectClusterController(); - &showSettings(); - &maybeRequireClusterSelection(); - &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)"); - - setOptionHeader("Options related to operation visibility:"); - setFlagOption(['n', 'no-wait'], \$no_wait, "Do not wait for node state " - . "changes to be visible in the cluster before returning."); - setFlagOption(['a', 'safe'], \$safe_mode, "Only carries out state changes " - . "if deemed safe by the cluster controller. For maintenance mode, " - . "will also set the distributor with the same distribution key " - . "to down atomically as part of the same state change. For up " - . "mode, transition is only allowed if the content node reports " - . "itself as up. Only supported for type storage."); - - 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(); -} - -sub maybeRequireClusterSelection -{ - return if Yahoo::Vespa::ContentNodeSelection::hasClusterSelection(); - my %clusters; - VespaModel::visitServices(sub { - my ($info) = @_; - if ($$info{'type'} =~ /^(?:distributor|storage|storagenode)$/ ) { - $clusters{$$info{'cluster'}} = 1; - } - }); - my $clusterCount = scalar keys %clusters; - if ($clusterCount > 1) { - printWarning "More than one cluster is present but no cluster is selected\n"; - exitApplication(1); - } -} - -# 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, $no_wait, $safe_mode); - ++$nodes_attempted_set; -} diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterController.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterController.pm deleted file mode 100644 index 9b594d780fe..00000000000 --- a/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterController.pm +++ /dev/null @@ -1,279 +0,0 @@ -# Copyright Yahoo. 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, NoWait, SafeMode) - my ($cluster, $service, $index, $state, $reason, $no_wait, $safe_mode) = @_; - 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 - } - } - }; - if ($no_wait) { - $request->{'response-wait'} = 'no-wait'; - } - if ($safe_mode) { - $request->{'condition'} = 'safe'; - } - 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 deleted file mode 100644 index 3c1b9acf4d1..00000000000 --- a/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterState.pm +++ /dev/null @@ -1,45 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 60db964e7f7..00000000000 --- a/vespaclient/src/perl/lib/Yahoo/Vespa/ConsoleOutput.pm +++ /dev/null @@ -1,331 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 0886cb50da0..00000000000 --- a/vespaclient/src/perl/lib/Yahoo/Vespa/ContentNodeSelection.pm +++ /dev/null @@ -1,145 +0,0 @@ -# Copyright Yahoo. 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. ' - . 'If unspecified, and vespa is installed on current node, ' - . 'information will be attempted auto-extracted'); - setFlagOption( - ['f', 'force'], - \$FORCE, - 'Force execution'); - if (($flags & CLUSTER_ONLY_LIMITATION) == 0) { - setStringOption( - ['t', 'type'], - \$NODE_TYPE, - 'Node type - can either be \'storage\' or ' - . '\'distributor\'. If not specified, the operation will use ' - . 'state for both types.'); - setIntegerOption( - ['i', 'index'], - \$INDEX, - 'Node index. If not specified, all nodes ' - . 'found running on this host will be used.'); - } -} -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; -} - -sub hasClusterSelection { - return defined $CLUSTER; -} - -############## 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 deleted file mode 100644 index 6b5e5380540..00000000000 --- a/vespaclient/src/perl/lib/Yahoo/Vespa/Http.pm +++ /dev/null @@ -1,179 +0,0 @@ -# Copyright Yahoo. 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; - my $tls_enabled = $ENV{'VESPA_TLS_ENABLED'}; - if (defined $tls_enabled and $tls_enabled eq '1') { - $BROWSER->ssl_opts( SSL_version => 'TLSv12'); - my $hostname_verification_disabled = $ENV{'VESPA_TLS_HOSTNAME_VALIDATION_DISABLED'}; - if (defined $hostname_verification_disabled and $hostname_verification_disabled eq '1') { - $BROWSER->ssl_opts( verify_hostname => 0); - } - $BROWSER->ssl_opts( SSL_cipher_list => 'ECDHE-RSA-AES128-GCM-SHA256:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES256-GCM-SHA384:ECDHE-RSA-CHACHA20-POLY1305:ECDHE-ECDSA-CHACHA20-POLY1305:TLS13-AES-128-GCM-SHA256:TLS13-AES-256-GCM-SHA384:TLS13-CHACHA20-POLY1305-SHA256' ); - } - if (defined $ENV{'VESPA_TLS_CA_CERT'}) { - $BROWSER->ssl_opts( SSL_ca_file => $ENV{'VESPA_TLS_CA_CERT'} ); - } - if (defined $ENV{'VESPA_TLS_CERT'}) { - $BROWSER->ssl_opts( SSL_cert_file => $ENV{'VESPA_TLS_CERT'} ); - } - if (defined $ENV{'VESPA_TLS_PRIVATE_KEY'}) { - $BROWSER->ssl_opts( SSL_key_file => $ENV{'VESPA_TLS_PRIVATE_KEY'} ); - } - $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 $tls_enabled = $ENV{'VESPA_TLS_ENABLED'}; - my $uri = (defined $tls_enabled and $tls_enabled eq '1') ? "https:" : "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 deleted file mode 100644 index d811c24ed7b..00000000000 --- a/vespaclient/src/perl/lib/Yahoo/Vespa/Json.pm +++ /dev/null @@ -1,52 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 609ec97f385..00000000000 --- a/vespaclient/src/perl/lib/Yahoo/Vespa/Utils.pm +++ /dev/null @@ -1,95 +0,0 @@ -# Copyright Yahoo. 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 (); - -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) { - &assertNotUnitTest(); - $HOSTNAME = `vespa-print-default 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 deleted file mode 100644 index 844ab6653b0..00000000000 --- a/vespaclient/src/perl/lib/Yahoo/Vespa/VespaModel.pm +++ /dev/null @@ -1,354 +0,0 @@ -# Copyright Yahoo. 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 vespa-get-config tool and config format. -# - Support direct communication with config server if config proxy is not -# running (unless vespa-get-config 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/vespa-get-config -l -n cloud.config.model -i admin/model'; - - if (defined $CONFIG_REQUEST_TIMEOUT) { - $cmd .= " -w $CONFIG_REQUEST_TIMEOUT"; - } - - if (!defined $CONFIG_SERVER_HOST) { - my $temp = `${VESPA_HOME}/bin/vespa-print-default configservers`; - chomp($temp); - $CONFIG_SERVER_HOST = $temp; - } - - if (!defined $CONFIG_SERVER_PORT) { - my $temp = `${VESPA_HOME}/bin/vespa-print-default configserver_rpc_port`; - chomp($temp); - $CONFIG_SERVER_PORT = $temp; - } - $cmd .= " -p $CONFIG_SERVER_PORT"; - - my $errors = ""; - foreach my $cfshost (split(' ', $CONFIG_SERVER_HOST)) { - my $hostcmd = $cmd . " -s $cfshost"; - - printDebug "Fetching model config '$hostcmd'.\n"; - my @data = `$hostcmd 2>&1`; - if ($? != 0 || join(' ', @data) =~ /^error/) { - $errors .= "Failed to get model config from config command line tool:\n" - . "Command: $hostcmd\n" - . "Exit code: $?\n" - . "Output: " . join("\n", @data) . "\n"; - } else { - return @data; - } - } - printError $errors; - exitApplication(1); -} -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 deleted file mode 100644 index 3b56873c775..00000000000 --- a/vespaclient/src/perl/test/Generic/UseTest.pl +++ /dev/null @@ -1,34 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index b6c67c81ed7..00000000000 --- a/vespaclient/src/perl/test/TestUtils/OutputCapturer.pm +++ /dev/null @@ -1,112 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 92a3cd0b1e0..00000000000 --- a/vespaclient/src/perl/test/TestUtils/VespaTest.pm +++ /dev/null @@ -1,92 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 870f31c1dfa..00000000000 --- a/vespaclient/src/perl/test/Yahoo/Vespa/ArgParserTest.pl +++ /dev/null @@ -1,313 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 6e2ec20c712..00000000000 --- a/vespaclient/src/perl/test/Yahoo/Vespa/Bin/GetClusterStateTest.pl +++ /dev/null @@ -1,65 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 626be8d37e7..00000000000 --- a/vespaclient/src/perl/test/Yahoo/Vespa/Bin/GetNodeStateTest.pl +++ /dev/null @@ -1,71 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 7546c8f4ef6..00000000000 --- a/vespaclient/src/perl/test/Yahoo/Vespa/Bin/SetNodeStateTest.pl +++ /dev/null @@ -1,133 +0,0 @@ -# Copyright Yahoo. 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. - -Options related to operation visibility: - -n --no-wait : Do not wait for node state changes to be visible in - the cluster before returning. - -Node selection options. By default, nodes running locally will be selected: - -c --cluster : Cluster name. If unspecified, - and vespa is installed on current node, information - will be attempted auto-extracted - -f --force : Force execution - -t --type : Node type - can either be 'storage' or - 'distributor'. If not specified, the operation will - use state for both types. - -i --index : Node index. If not specified, - all nodes found running on this host will be used. - -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 deleted file mode 100644 index a833fad4087..00000000000 --- a/vespaclient/src/perl/test/Yahoo/Vespa/ClusterControllerTest.pl +++ /dev/null @@ -1,49 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 2089bf80d8e..00000000000 --- a/vespaclient/src/perl/test/Yahoo/Vespa/ConsoleOutputTest.pl +++ /dev/null @@ -1,47 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 1e3e97bb829..00000000000 --- a/vespaclient/src/perl/test/Yahoo/Vespa/HttpTest.pl +++ /dev/null @@ -1,140 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index b0eb7962b33..00000000000 --- a/vespaclient/src/perl/test/Yahoo/Vespa/JsonTest.pl +++ /dev/null @@ -1,67 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index cb642dbc629..00000000000 --- a/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/ClusterControllerMock.pm +++ /dev/null @@ -1,258 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 2840da9899a..00000000000 --- a/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/HttpClientMock.pm +++ /dev/null @@ -1,55 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 00a6f1526b2..00000000000 --- a/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/HttpServerMock.pm +++ /dev/null @@ -1,156 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 63ff9f767d1..00000000000 --- a/vespaclient/src/perl/test/Yahoo/Vespa/Mocks/VespaModelMock.pm +++ /dev/null @@ -1,96 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index d1c1a1bb0d9..00000000000 --- a/vespaclient/src/perl/test/Yahoo/Vespa/VespaModelTest.pl +++ /dev/null @@ -1,63 +0,0 @@ -# Copyright Yahoo. 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 deleted file mode 100644 index 8dca35ad91d..00000000000 --- a/vespaclient/src/perl/test/testrunner.pl +++ /dev/null @@ -1,110 +0,0 @@ -#!/usr/bin/perl -w -# Copyright Yahoo. 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); -} |