diff options
Diffstat (limited to 'vespaclient/src/perl/lib/Yahoo/Vespa')
-rw-r--r-- | vespaclient/src/perl/lib/Yahoo/Vespa/ArgParser.pm | 689 | ||||
-rw-r--r-- | vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetClusterState.pm | 124 | ||||
-rw-r--r-- | vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetNodeState.pm | 119 | ||||
-rw-r--r-- | vespaclient/src/perl/lib/Yahoo/Vespa/Bin/SetNodeState.pm | 127 | ||||
-rw-r--r-- | vespaclient/src/perl/lib/Yahoo/Vespa/ClusterController.pm | 279 | ||||
-rw-r--r-- | vespaclient/src/perl/lib/Yahoo/Vespa/ClusterState.pm | 45 | ||||
-rw-r--r-- | vespaclient/src/perl/lib/Yahoo/Vespa/ConsoleOutput.pm | 331 | ||||
-rw-r--r-- | vespaclient/src/perl/lib/Yahoo/Vespa/ContentNodeSelection.pm | 145 | ||||
-rw-r--r-- | vespaclient/src/perl/lib/Yahoo/Vespa/Http.pm | 179 | ||||
-rw-r--r-- | vespaclient/src/perl/lib/Yahoo/Vespa/Json.pm | 52 | ||||
-rw-r--r-- | vespaclient/src/perl/lib/Yahoo/Vespa/Utils.pm | 95 | ||||
-rw-r--r-- | vespaclient/src/perl/lib/Yahoo/Vespa/VespaModel.pm | 354 |
12 files changed, 0 insertions, 2539 deletions
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"; -} - |