summaryrefslogtreecommitdiffstats
path: root/vespaclient/src/perl/lib/Yahoo/Vespa
diff options
context:
space:
mode:
Diffstat (limited to 'vespaclient/src/perl/lib/Yahoo/Vespa')
-rw-r--r--vespaclient/src/perl/lib/Yahoo/Vespa/ArgParser.pm689
-rw-r--r--vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetClusterState.pm124
-rw-r--r--vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetNodeState.pm119
-rw-r--r--vespaclient/src/perl/lib/Yahoo/Vespa/Bin/SetNodeState.pm127
-rw-r--r--vespaclient/src/perl/lib/Yahoo/Vespa/ClusterController.pm279
-rw-r--r--vespaclient/src/perl/lib/Yahoo/Vespa/ClusterState.pm45
-rw-r--r--vespaclient/src/perl/lib/Yahoo/Vespa/ConsoleOutput.pm331
-rw-r--r--vespaclient/src/perl/lib/Yahoo/Vespa/ContentNodeSelection.pm145
-rw-r--r--vespaclient/src/perl/lib/Yahoo/Vespa/Http.pm179
-rw-r--r--vespaclient/src/perl/lib/Yahoo/Vespa/Json.pm52
-rw-r--r--vespaclient/src/perl/lib/Yahoo/Vespa/Utils.pm95
-rw-r--r--vespaclient/src/perl/lib/Yahoo/Vespa/VespaModel.pm354
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) = @_;
-
- &registerInternalParameters();
- 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";
-}
-