Publish

12 files changed, 2478 insertions, 0 deletions

diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/ArgParser.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/ArgParser.pm
new file mode 100644
index 00000000000..c6b0fb0f157
--- /dev/null
+++ b/vespaclient/src/perl/lib/Yahoo/Vespa/ArgParser.pm
@@ -0,0 +1,689 @@
+# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root.
+#
+# Argument parser.
+#
+# Intentions:
+#   - Make it very easy for programs to get info from command line.
+#   - Allow shared libraries to register own options, such that a program can
+#     delegate command line options to libraries used. (For instance, verbosity
+#     arguments will be automatically delegated to console output module without
+#     program needing to care much.
+#   - Create a unified looking syntax page for all command line tools.
+#   - Be able to reuse input validation. For instance that an integer don't
+#     have a decimal point and that a hostname can be resolved.
+# 
+
+package Yahoo::Vespa::ArgParser;
+
+use strict;
+use warnings;
+use Yahoo::Vespa::ConsoleOutput;
+use Yahoo::Vespa::Utils;
+
+BEGIN { # - Define exports and dependency aliases for module.
+    use base 'Exporter';
+    our @EXPORT = qw(
+        addArgParserValidator
+        setProgramBinaryName setProgramDescription
+        setArgument setOptionHeader
+        setFlagOption setHostOption setPortOption setStringOption
+        setIntegerOption setFloatOption setUpCountingOption setDownCountingOption
+        handleCommandLineArguments
+        OPTION_SECRET OPTION_INVERTEDFLAG OPTION_REQUIRED
+    );
+        # Alias so we can avoid writing the entire package name
+    *ConsoleOutput:: = *Yahoo::Vespa::ConsoleOutput::
+}
+
+my @ARGUMENTS;
+my $DESCRIPTION;
+my $BINARY_NAME;
+my @ARG_SPEC_ARRAY;
+my %OPTION_SPEC;
+my @OPTION_SPEC_ARRAY;
+my $SYNTAX_PAGE;
+my $SHOW_HIDDEN;
+my @VALIDATORS;
+use constant OPTION_SECRET => 1;
+use constant OPTION_INVERTEDFLAG => 2;
+use constant OPTION_ADDFIRST => 4;
+use constant OPTION_REQUIRED => 8;
+
+# These variables are properties needed by ConsoleOutput module. ArgParser
+# handles that modules argument settings as it cannot possibly depend upon
+# ArgParser itself.
+my $VERBOSITY; # Default verbosity before parsing arguments
+my $ANSI_COLORS; # Whether to use ansi colors or not.
+
+&initialize();
+
+return 1;
+
+########################## Default exported functions ########################
+
+sub handleCommandLineArguments { # () Parses and sets all values
+    my ($args, $validate_args_sub) = @_;
+
+    &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
new file mode 100644
index 00000000000..13d645d46de
--- /dev/null
+++ b/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetClusterState.pm
@@ -0,0 +1,124 @@
+# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root.
+
+package Yahoo::Vespa::Bin::GetClusterState;
+
+use strict;
+use warnings;
+use Yahoo::Vespa::ArgParser;
+use Yahoo::Vespa::ClusterController;
+use Yahoo::Vespa::ConsoleOutput;
+use Yahoo::Vespa::ContentNodeSelection;
+use Yahoo::Vespa::Utils;
+use Yahoo::Vespa::VespaModel;
+
+BEGIN {
+    use base 'Exporter';
+    our @EXPORT = qw(
+        getClusterState
+    );
+}
+
+my %cluster_states;
+
+return &init();
+
+sub init {
+    %cluster_states = ();
+    return 1;
+}
+
+# Run the get node state tool
+sub getClusterState { # (Command line arguments)
+    my ($argsref) = @_;
+    &handleCommandLine($argsref);
+    detectClusterController();
+    &showSettings();
+    &showNodeStates();
+}
+
+# Parse command line arguments
+sub handleCommandLine { # (Command line arguments)
+    my ($args) = @_;
+    my $description = <<EOS;
+Get the cluster state of a given cluster.
+
+EOS
+    $description =~ s/(\S)\n(\S)/$1 $2/gs;
+    chomp $description;
+
+    setProgramDescription($description);
+    Yahoo::Vespa::ContentNodeSelection::registerCommandLineArguments(
+            NO_LOCALHOST_CONSTRAINT | CLUSTER_ONLY_LIMITATION);
+    Yahoo::Vespa::VespaModel::registerCommandLineArguments();
+    handleCommandLineArguments($args);
+}
+
+# Show what settings this tool is running with (if verbosity is high enough)
+sub showSettings { # ()
+    &Yahoo::Vespa::ClusterController::showSettings();
+}
+
+# Print all state we want to show for this request
+sub showNodeStates { # ()
+    
+    Yahoo::Vespa::ContentNodeSelection::visit(\&showNodeStateForNode);
+}
+
+# Get the node state from cluster controller, unless already cached
+sub getStateForNode { # (Type, Index, Cluster)
+    my ($type, $index, $cluster) = @_;
+    if (!exists $cluster_states{$cluster}) {
+        my $state = getContentClusterState($cluster);
+        $cluster_states{$cluster} = $state;
+        if ($state->globalState eq "up") {
+            printResult "\nCluster $cluster:\n";
+        } else {
+            printResult "\nCluster $cluster is " . COLOR_ERR
+                    . $state->globalState . COLOR_RESET
+                    . ". Too few nodes available.\n";
+        }
+    }
+    return $cluster_states{$cluster}->$type->{$index};
+}
+
+# Print all states for a given node
+sub showNodeStateForNode { # (Service, Index, NodeState, Model, ClusterName)
+    my ($info) = @_;
+    my ($cluster, $type, $index) = (
+            $$info{'cluster'}, $$info{'type'}, $$info{'index'});
+    my $nodestate = &getStateForNode($type, $index, $cluster);
+    defined $nodestate or confess "No nodestate for $type $index $cluster";
+    my $generated = $nodestate->generated;
+    my $id = $cluster . "/";
+    if (defined $nodestate->group) {
+        $id .= $nodestate->group;
+    }
+    my $msg = "$cluster/$type/$index: ";
+    if ($generated->state ne 'up') {
+        $msg .= COLOR_ERR;
+    }
+    $msg .= $generated->state;
+    if ($generated->state ne 'up') {
+        $msg .= COLOR_RESET;
+    }
+    # TODO: Make the Cluster Controller always populate the reason for the
+    # generated state.  Until then we'll avoid printing it to avoid confusion.
+    # Use vespa-get-node-state to see the reasons on generated, user, and unit.
+    #
+    # if (length $generated->reason > 0) {
+    #     $msg .= ': ' . $generated->reason;
+    # }
+    printResult $msg . "\n";
+}
+
+# ClusterState(Version: 7, Cluster state: Up, Distribution bits: 1) {
+#   Group 0: mygroup. 1 node [0] {
+#     All nodes in group up and available.
+#   }
+# }
+
+# ClusterState(Version: 7, Cluster state: Up, Distribution bits: 1) {
+#   Group 0: mygroup. 1 node [0] {
+#     storage.0: Retired: foo
+#   }
+# }
diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetNodeState.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetNodeState.pm
new file mode 100644
index 00000000000..1e82c05db0a
--- /dev/null
+++ b/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/GetNodeState.pm
@@ -0,0 +1,119 @@
+# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root.
+
+package Yahoo::Vespa::Bin::GetNodeState;
+
+use strict;
+use warnings;
+use Yahoo::Vespa::ArgParser;
+use Yahoo::Vespa::ClusterController;
+use Yahoo::Vespa::ConsoleOutput;
+use Yahoo::Vespa::ContentNodeSelection;
+use Yahoo::Vespa::Utils;
+
+BEGIN {
+    use base 'Exporter';
+    our @EXPORT = qw(
+        getNodeState
+    );
+}
+
+our $resultdesc;
+our %cluster_states;
+
+return 1;
+
+# Run the get node state tool
+sub getNodeState { # (Command line arguments)
+    my ($argsref) = @_;
+    &handleCommandLine($argsref);
+    detectClusterController();
+    &showSettings();
+    &showNodeStates();
+}
+
+# Parse command line arguments
+sub handleCommandLine { # (Command line arguments)
+    my ($args) = @_;
+    $resultdesc = <<EOS;
+Shows the various states of one or more nodes in a Vespa Storage cluster.
+There exist three different type of node states. They are:
+
+  Unit state      - The state of the node seen from the cluster controller.
+  User state      - The state we want the node to be in. By default up. Can be
+                    set by administrators or by cluster controller when it
+                    detects nodes that are behaving badly.
+  Generated state - The state of a given node in the current cluster state.
+                    This is the state all the other nodes know about. This
+                    state is a product of the other two states and cluster
+                    controller logic to keep the cluster stable.
+EOS
+    $resultdesc =~ s/\s*\n(\S.)/ $1/gs;
+    chomp $resultdesc;
+    my $description = <<EOS;
+Retrieve the state of one or more storage services from the fleet controller.
+Will list the state of the locally running services, possibly restricted to
+less by options.
+
+$resultdesc
+
+EOS
+    $description =~ s/(\S)\n(\S)/$1 $2/gs;
+    chomp $description;
+
+    setProgramDescription($description);
+    Yahoo::Vespa::ContentNodeSelection::registerCommandLineArguments();
+    Yahoo::Vespa::VespaModel::registerCommandLineArguments();
+    handleCommandLineArguments($args);
+}
+
+# Show what settings this tool is running with (if verbosity is high enough)
+sub showSettings { # ()
+    &Yahoo::Vespa::ClusterController::showSettings();
+    &Yahoo::Vespa::ContentNodeSelection::showSettings();
+}
+
+# Print all state we want to show for this request
+sub showNodeStates { # ()
+    printInfo $resultdesc . "\n";
+    Yahoo::Vespa::ContentNodeSelection::visit(\&showNodeStateForNode);
+}
+
+# Get the node state from cluster controller, unless already cached
+sub getStateForNode { # (Type, Index, Cluster)
+    my ($type, $index, $cluster) = @_;
+    if (!exists $cluster_states{$cluster}) {
+        $cluster_states{$cluster} = getContentClusterState($cluster);
+    }
+    return $cluster_states{$cluster}->$type->{$index};
+}
+
+# Print all states for a given node
+sub showNodeStateForNode { # (Service, Index, NodeState, Model, ClusterName)
+    my ($info) = @_;
+    my ($cluster, $type, $index) = (
+            $$info{'cluster'}, $$info{'type'}, $$info{'index'});
+    printResult "\n$cluster/$type.$index:\n";
+    my $nodestate = &getStateForNode($type, $index, $cluster);
+    printState('Unit', $nodestate->unit);
+    printState('Generated', $nodestate->generated);
+    printState('User', $nodestate->user);
+}
+
+# Print the value of a single state type for a node
+sub printState { # (State name, State)
+    my ($name, $state) = @_;
+    if (!defined $state) {
+        printResult $name . ": UNKNOWN\n";
+    } else {
+        my $msg = $name . ": ";
+        if ($state->state ne 'up') {
+            $msg .= COLOR_ERR;
+        }
+        $msg .= $state->state;
+        if ($state->state ne 'up') {
+            $msg .= COLOR_RESET;
+        }
+        $msg .= ": " . $state->reason . "\n";
+        printResult $msg;
+    }
+}
diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/SetNodeState.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/SetNodeState.pm
new file mode 100644
index 00000000000..bdf276c3677
--- /dev/null
+++ b/vespaclient/src/perl/lib/Yahoo/Vespa/Bin/SetNodeState.pm
@@ -0,0 +1,97 @@
+# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root.
+
+package Yahoo::Vespa::Bin::SetNodeState;
+
+use strict;
+use warnings;
+use Yahoo::Vespa::ClusterController;
+use Yahoo::Vespa::ConsoleOutput;
+use Yahoo::Vespa::ContentNodeSelection;
+use Yahoo::Vespa::ArgParser;
+use Yahoo::Vespa::Utils;
+
+BEGIN {
+    use base 'Exporter';
+    our @EXPORT = qw(
+        setNodeState
+    );
+}
+
+our $wanted_state;
+our $wanted_state_description;
+our $nodes_attempted_set;
+our $success;
+
+return 1;
+
+# Run the set node state tool
+sub setNodeState { # (Command line arguments)
+    my ($argsref) = @_;
+    &handleCommandLine($argsref);
+    detectClusterController();
+    &showSettings();
+    &execute();
+}
+
+# Parse command line arguments
+sub handleCommandLine { # (Command line arguments)
+    my ($args) = @_;
+    my $description = <<EOS;
+Set the user state of a node. This will set the generated state to the user
+state if the user state is "better" than the generated state that would have
+been created if the user state was up. For instance, a node that is currently
+in initializing state can be forced into down state, while a node that is
+currently down can not be forced into retired state, but can be forced into
+maintenance state.
+EOS
+    $description =~ s/(\S)\n(\S)/$1 $2/gs;
+    chomp $description;
+
+    setProgramDescription($description);
+
+    setArgument(\$wanted_state, "Wanted State",
+                "User state to set. This must be one of "
+              . "up, down, maintenance or retired.",
+                OPTION_REQUIRED);
+    setArgument(\$wanted_state_description, "Description",
+                "Give a reason for why you are altering the user state, which "
+              . "will show up in various admin tools. (Use double quotes to "
+              . "give a reason with whitespace in it)");
+
+    Yahoo::Vespa::ContentNodeSelection::registerCommandLineArguments();
+    Yahoo::Vespa::VespaModel::registerCommandLineArguments();
+    handleCommandLineArguments($args);
+
+    if (!Yahoo::Vespa::ContentNodeSelection::validateCommandLineArguments(
+             $wanted_state)) {
+        exitApplication(1);
+    }
+}
+
+# Show what settings this tool is running with (if verbosity is high enough)
+sub showSettings { # ()
+    Yahoo::Vespa::ClusterController::showSettings();
+}
+
+# Sets the node state
+sub execute { # ()
+    $success = 1;
+    $nodes_attempted_set = 0;
+    Yahoo::Vespa::ContentNodeSelection::visit(\&setNodeStateForNode);
+    if ($nodes_attempted_set == 0) {
+        printWarning("Attempted setting of user state for no nodes");
+        exitApplication(1);
+    }
+    if (!$success) {
+	exitApplication(1);
+    }
+}
+
+sub setNodeStateForNode {
+    my ($info) = @_;
+    my ($cluster, $type, $index) = (
+            $$info{'cluster'}, $$info{'type'}, $$info{'index'});
+    $success &&= setNodeUserState($cluster, $type, $index, $wanted_state,
+                                  $wanted_state_description);
+    ++$nodes_attempted_set;
+}
diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterController.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterController.pm
new file mode 100644
index 00000000000..cbe6deea9e4
--- /dev/null
+++ b/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterController.pm
@@ -0,0 +1,273 @@
+# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root.
+#
+# Handles Rest API requests to State Rest API in cluster controller, making
+# wanted data programmatically available.
+#
+package Yahoo::Vespa::ClusterController;
+
+use strict;
+use warnings;
+use Class::Struct;
+use Yahoo::Vespa::ArgParser;
+use Yahoo::Vespa::ClusterState;
+use Yahoo::Vespa::ConsoleOutput;
+use Yahoo::Vespa::Http;
+use Yahoo::Vespa::Json;
+use Yahoo::Vespa::Utils;
+use Yahoo::Vespa::VespaModel;
+
+BEGIN { # - Exports and aliases for the module
+    use base 'Exporter';
+    our $VERSION = '1.0';
+    our @EXPORT = qw(
+        detectClusterController
+        getContentClusterState
+        setNodeUserState
+    ); # Exported unless specifically left out by user
+        # Alias namespaces
+    *VespaModel:: = *Yahoo::Vespa::VespaModel:: ;
+    *Http:: = *Yahoo::Vespa::Http:: ;
+    *Json:: = *Yahoo::Vespa::Json:: ;
+}
+
+struct( ClusterController => {
+    index => '$', # Logical index of the cluster controller
+    host => '$', # Host on which cluster controller runs
+    port => '$' # Port where cluster controller is available
+});
+
+my %CACHED_CLUSTER_STATES;
+my @CLUSTER_CONTROLLERS;
+
+return &init();
+
+########################## Default exported functions ########################
+
+sub init {
+    %CACHED_CLUSTER_STATES = ();
+    @CLUSTER_CONTROLLERS = ();
+    return 1;
+}
+
+sub detectClusterController { # ()
+    if (scalar @CLUSTER_CONTROLLERS == 0) {
+        use Yahoo::Vespa::VespaModel;
+        printDebug "Attempting to auto-detect cluster controller location\n";
+        my $sockets = VespaModel::getSocketForService(
+                type => 'container-clustercontroller', tag => 'state');
+        foreach my $sock (sort { $a->{'index'} <=> $b->{'index'} } @$sockets) {
+            my $cc = new ClusterController;
+            $cc->index($sock->{'index'});
+            $cc->host($sock->{'host'});
+            $cc->port($sock->{'port'});
+            push @CLUSTER_CONTROLLERS, $cc;
+        }
+        if (scalar @$sockets == 0) {
+            my $oldVal = enableAutomaticLineBreaks(0);
+            printSpam dumpStructure(VespaModel::get());
+            enableAutomaticLineBreaks($oldVal);
+            printError "Failed to detect cluster controller to talk to. "
+                     . "Resolve issue that failed automatic detection or "
+                     . "provide cluster controller socket through command "
+                     . "line options. (See --help)\n";
+            exitApplication(1);
+        }
+        &showSettings();
+        printSpam "Content of vespa model inspected to find cluster "
+                . "controller:\n";
+        my $oldVal = enableAutomaticLineBreaks(0);
+        printSpam dumpStructure(VespaModel::get());
+        enableAutomaticLineBreaks($oldVal);
+    }
+}
+sub setNodeUserState { # (ClusterName, NodeType, Index, State, Reason)
+    my ($cluster, $service, $index, $state, $reason) = @_;
+    my @params = ();
+    my @headers = (
+        'Content-Type' => 'application/json'
+    );
+    $state =~ tr/A-Z/a-z/;
+    $state =~ /(?:up|down|maintenance|retired)$/
+            or confess "Invalid state '$state' attempted set.\n";
+    if (!defined $reason) {
+        $reason = "";
+    }
+    my $request = {
+        "state" => {
+            "user" => {
+                "state" => $state,
+                "reason" => $reason
+            }
+        }
+    };
+    my $content = Json::encode($request);
+
+    my $path = &getPathToNode($cluster, $service, $index);
+    my %response = &requestCC('POST', $path, \@params, $content, \@headers);
+    if (defined $response{'all'}) { printSpam $response{'all'}; }
+    printDebug $response{'code'} . " " . $response{'status'} . "\n";
+    printInfo exists($response{'content'}) ? $response{'content'} : '';
+    if ($response{'code'} >= 200 && $response{'code'} < 300) {
+        printResult "$response{'status'}\n";
+        return 1
+    } else {
+        printWarning "Failed to set node state for node "
+                   . "$cluster/$service/$index: "
+                   . "$response{'code'} $response{'status'}\n";
+        return 0
+    }
+}
+sub getContentClusterState { # (ClusterName) -> ClusterState
+    my ($cluster) = @_;
+    if (!exists $CACHED_CLUSTER_STATES{$cluster}) {
+        $CACHED_CLUSTER_STATES{$cluster} = &fetchContentClusterState($cluster);
+    }
+    return $CACHED_CLUSTER_STATES{$cluster};
+}
+
+######################## Externally usable functions #######################
+
+sub getClusterControllers { # ()
+    return \@CLUSTER_CONTROLLERS;
+}
+sub showSettings { # ()
+    printDebug "Cluster controllers:\n";
+    foreach my $cc (@CLUSTER_CONTROLLERS) {
+        printDebug "  " . $cc->index . ": "
+                . $cc->host . ":" . $cc->port . "\n";
+    }
+}
+
+############## Utility functions - Not intended for external use #############
+
+sub fetchContentClusterState { # (ClusterName) -> ClusterState
+    my ($cluster) = @_;
+    my @params = (
+        'recursive' => 'true'
+    );
+    my %response = &getCC("/cluster/v2/$cluster/", \@params);
+    if ($response{'code'} != 200) {
+        printError "Failed to fetch cluster state of content cluster "
+                 . "'$cluster':\n" . $response{'all'} . "\n";
+        exitApplication(1);
+    }
+    my $json = Json::parse($response{'content'});
+    my $result = new ClusterState;
+    &fillInGlobalState($cluster, $result, $json);
+    &fillInNodes($result, 'distributor',
+                 &getJsonValue($json, ['service', 'distributor', 'node']));
+    &fillInNodes($result, 'storage',
+                 &getJsonValue($json, ['service', 'storage', 'node']));
+    return $result;
+}
+sub fillInGlobalState { # (ClusterName, StateToFillIn, JsonToParse)
+    my ($cluster, $state, $json) = @_;
+    my $e = &getJsonValue($json, ['state', 'generated', 'state']);
+    if (defined $e) {
+        $state->globalState($e);
+        if (!Yahoo::Vespa::ClusterState::legalState($state->globalState())) {
+            printWarning "Illegal global cluster state $e found.\n";
+        }
+    } else {
+        printDebug dumpStructure($json) . "\n";
+        printWarning "Found no global cluster state\n";
+    }
+}
+sub getPathToNode { # (ClusterName, NodeType, Index) 
+    my ($cluster, $service, $index) = @_;
+    return "/cluster/v2/$cluster/$service/$index";
+}
+sub listContentClusters { # () -> (ContentClusterName, ...)
+    my %result = &getCC("/cluster/v2/");
+    if ($result{'code'} != 200) {
+        printError "Failed to fetch list of content clusters:\n"
+                 . $result{'all'} . "\n";
+        exitApplication(1);
+    }
+    my $json = Json::parse($result{'content'});
+    return keys %{ $json->{'cluster'} };
+}
+sub fillInNodes { # (StateToFillIn, ServiceType, json)
+    my ($state, $service, $json) = @_;
+    foreach my $index (%{ $json }) {
+        my $node = new Node;
+        &parseNode($node, $json->{$index});
+        $state->$service($index, $node);
+    }
+}
+sub parseNode { # (StateToFillIn, JsonToParse)
+    my ($node, $json) = @_;
+    my $group = &getJsonValue($json, ['attributes', 'hierarchical-group']);
+    if (defined $group && $group =~ /^[^\.]*\.(.*)$/) {
+        $node->group($1);
+    }
+    parseState($node, $json, 'unit');
+    parseState($node, $json, 'generated');
+    parseState($node, $json, 'user');
+    my $partitions = $json->{'partition'};
+    if (defined $partitions) {
+        foreach my $index (%{ $json->{'partition'} }) {
+            my $partition = new Partition;
+            parsePartition($partition, $json->{'partition'}->{$index});
+            $node->partition($index, $partition);
+        }
+    }
+}
+sub parsePartition { # (StateToFillIn, JsonToParse)
+    my ($partition, $json) = @_;
+    my $buckets = &getJsonValue($json, ['metrics', 'bucket-count']);
+    my $doccount = &getJsonValue($json, ['metrics', 'unique-document-count']);
+    my $size = &getJsonValue($json, ['metrics', 'unique-document-total-size']);
+    $partition->bucketcount($buckets);
+    $partition->doccount($doccount);
+    $partition->totaldocsize($size);
+}
+sub parseState { # (StateToFillIn, JsonToParse, StateType)
+    my ($node, $json, $type) = @_;
+    my $value = &getJsonValue($json, ['state', $type, 'state']);
+    my $reason = &getJsonValue($json, ['state', $type, 'reason']);
+    if (defined $value) {
+        my $state = new State;
+        $state->state($value);
+        $state->reason($reason);
+        $state->source($type);
+        $node->$type($state);
+    }
+}
+sub getJsonValue { # (json, [ keys ])
+    my ($json, $keys) = @_;
+    foreach my $key (@$keys) {
+        if (!defined $json) { return; }
+        $json = $json->{$key};
+    }
+    return $json;
+}
+sub getCC { # (Path, Params, Headers) -> Response
+    my ($path, $params, $headers) = @_;
+    return requestCC('GET', $path, $params, undef, $headers);
+}
+sub requestCC { # (Type, Path, Params, Content, Headers) -> Response
+    my ($type, $path, $params, $content, $headers) = @_;
+    my %response;
+    foreach my $cc (@CLUSTER_CONTROLLERS) {
+        %response = Http::request($type, $cc->host, $cc->port, $path,
+                                  $params, $content, $headers);
+        if ($response{'code'} == 200) {
+            return %response;
+        } elsif ($response{'code'} == 307) {
+            my %headers = $response{'headers'};
+            my $masterlocation = $headers{'Location'};
+            if (defined $masterlocation) {
+                if ($masterlocation =~ /http:\/\/([^\/:]+):(\d+)\//) {
+                    my ($host, $port) = ($1, $2);
+                    return Http::request($type, $host, $port, $path,
+                                      $params, $content, $headers);
+                } else {
+                    printError("Unhandled relocaiton URI '$masterlocation'.");
+                    exitApplication(1);
+                }
+            }
+        }
+    }
+    return %response;
+}
diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterState.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterState.pm
new file mode 100644
index 00000000000..648f158f9db
--- /dev/null
+++ b/vespaclient/src/perl/lib/Yahoo/Vespa/ClusterState.pm
@@ -0,0 +1,45 @@
+# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root.
+#
+# Defines structs to represent a cluster state
+#
+package Yahoo::Vespa::ClusterState;
+
+use strict;
+use warnings;
+use Class::Struct;
+
+struct( ClusterState => {
+    globalState => '$', # A state primitive
+    distributor => '%', # Index to Node map
+    storage => '%'      # Index to Node map
+});
+
+struct( Node => {
+    group => '$',         # Hierarchical group node belongs to
+    unit => 'State',
+    generated => 'State',
+    user => 'State',
+    partition => '%'
+});
+
+struct( Partition => {
+    generated => 'State',
+    bucketcount => '$',
+    doccount => '$',
+    totaldocsize => '$'
+});
+
+struct( State => {
+    state => '$',     # A state primitive
+    reason => '$',    # Textual reason for it to be set.
+    timestamp => '$', # Timestamp of the time it got set.
+    source => '$'     # What type of state is it (unit/generated/user)
+});
+
+return 1;
+
+sub legalState { # (State) -> Bool
+    my ($state) = @_;
+    return ($state =~ /^(up|down|maintenance|retired|stopping|initializing)$/);
+}
+
diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/ConsoleOutput.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/ConsoleOutput.pm
new file mode 100644
index 00000000000..73a0a016592
--- /dev/null
+++ b/vespaclient/src/perl/lib/Yahoo/Vespa/ConsoleOutput.pm
@@ -0,0 +1,331 @@
+# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root.
+#
+# Output handler
+#
+# Intentions:
+#   - Make it easy for unit tests to redirect output.
+#   - Allow programmers to add all sorts of debug information into tools usable
+#     for debugging, while hiding it by default for real users.
+#   - Allow generic functionality that can be reused by all. For instance color 
+#     coding of very important information.
+#
+# Ideas for improvement:
+#   - Could possibly detect terminal width and do proper line breaking of long
+#     lines
+#
+# A note about colors:
+#   - This module will detect if terminal supports colors. If not, it will not
+#     print any. (Color support can be turned off by giving --nocolors argument
+#     through argument parser, by setting a TERM value that does not support
+#     colors or programmatically call setUseAnsiColors(0).
+#   - Currently only red and grey are used in addition to default. These colors
+#     should work well for both light and dark backgrounds.
+# 
+
+package Yahoo::Vespa::ConsoleOutput;
+
+use strict;
+use warnings;
+use Yahoo::Vespa::Utils;
+
+BEGIN { # - Define exports for modul
+    use base 'Exporter';
+    our @EXPORT = qw(
+        printResult printError printWarning printInfo printDebug printSpam
+        enableAutomaticLineBreaks
+        COLOR_RESET COLOR_WARN COLOR_ERR COLOR_ANON
+    );
+    our @EXPORT_OK = qw(
+        getTerminalWidth getVerbosity usingAnsiColors ansiColorsSupported
+        setVerbosity
+    );
+}
+
+my %TYPES = (
+    'result'  => 0, # Output from a tool. Expected when app runs successfully.
+    'error'   => 1, # Error found, typically aborting the script with a failure.
+    'warning' => 2, # An issue that may or may not cause the program to fail.
+    'info'    => 3, # Useful information to get from the script.
+    'debug'   => 4, # Debug information useful to debug script or to see
+                    # internals of what is happening.
+    'spam'    => 5, # Spammy information used when large amounts of details is
+                    # wanted. Typically to debug some failure.
+);
+my $VERBOSITY; # Current verbosity level
+my $ANSI_COLORS_SUPPORTED; # True if terminal supports colors
+my $ANSI_COLORS; # True if we want to use colors (and support it)
+my %ATTRIBUTE_PREFIX; # Ansi escape prefixes for verbosity levels
+my %ATTRIBUTE_POSTFIX; # Ansi escape postfixes for verbosity levels
+my %OUTPUT_STREAM; # Where to write different verbosity levels (stdout|stderr)
+my $TERMINAL_WIDTH; # With of terminal in columns
+my $COLUMN_POSITION; # Current index of cursor in terminal
+my $ENABLE_AUTO_LINE_BREAKS;
+
+use constant COLOR_RESET => "\e[0m";
+use constant COLOR_ERR => "\e[91m";
+use constant COLOR_WARN => "\e[93m";
+use constant COLOR_ANON => "\e[90m";
+
+&initialize(*STDOUT, *STDERR);
+
+return 1;
+
+########################## Default exported functions ########################
+
+sub printResult { # (Output...)
+    printAtLevel('result', @_);
+}
+sub printError { # (Output...)
+    printAtLevel('error', @_);
+}
+sub printWarning { # (Output...)
+    printAtLevel('warning', @_);
+}
+sub printInfo { # (Output...)
+    printAtLevel('info', @_);
+}
+sub printDebug { # (Output...)
+    printAtLevel('debug', @_);
+}
+sub printSpam { # (Output...)
+    printAtLevel('spam', @_);
+}
+sub enableAutomaticLineBreaks { # (Bool) -> (OldValue)
+    my $oldval = $ENABLE_AUTO_LINE_BREAKS;
+    $ENABLE_AUTO_LINE_BREAKS = ($_[0] ? 1 : 0);
+    return $oldval;
+}
+
+######################## Optionally exported functions #######################
+
+sub getTerminalWidth { # () -> ColumnCount
+        # May be undefined if someone prints before initialized
+    return (defined $TERMINAL_WIDTH ? $TERMINAL_WIDTH : 80);
+}
+sub getVerbosity { # () -> VerbosityLevel
+    return $VERBOSITY;
+}
+sub usingAnsiColors { # () -> Bool
+    return $ANSI_COLORS;
+}
+sub ansiColorsSupported { # () -> Bool
+    return $ANSI_COLORS_SUPPORTED;
+}
+sub setVerbosity { # (VerbosityLevel)
+    $VERBOSITY = $_[0];
+}
+
+################## Functions for unit tests to mock internals ################
+
+sub setTerminalWidth { # (ColumnCount)
+    $TERMINAL_WIDTH = $_[0];
+}
+sub setUseAnsiColors { # (Bool)
+    if ($ANSI_COLORS_SUPPORTED && $_[0]) {
+        $ANSI_COLORS = 1;
+    } else {
+        $ANSI_COLORS = 0;
+    }
+}
+
+############## Utility functions - Not intended for external use #############
+
+sub initialize { # ()
+    my ($stdout, $stderr, $use_colors_by_default) = @_;
+    if (!defined $VERBOSITY) {
+        $VERBOSITY = &getDefaultVerbosity();
+    }
+    $COLUMN_POSITION = 0;
+    $ENABLE_AUTO_LINE_BREAKS = 1;
+    %ATTRIBUTE_PREFIX = map { $_ => '' } keys %TYPES;
+    %ATTRIBUTE_POSTFIX = map { $_ => '' } keys %TYPES;
+    &setAttribute('error', COLOR_ERR, COLOR_RESET);
+    &setAttribute('warning', COLOR_WARN, COLOR_RESET);
+    &setAttribute('debug', COLOR_ANON, COLOR_RESET);
+    &setAttribute('spam', COLOR_ANON, COLOR_RESET);
+    %OUTPUT_STREAM = map { $_ => $stdout } keys %TYPES;
+    $OUTPUT_STREAM{'error'} = $stderr;
+    $OUTPUT_STREAM{'warning'} = $stderr;
+    if (defined $use_colors_by_default) {
+        $ANSI_COLORS_SUPPORTED = $use_colors_by_default;
+        $ANSI_COLORS = $ANSI_COLORS_SUPPORTED;
+    } else {
+        &detectTerminalColorSupport();
+    }
+    if (!defined $TERMINAL_WIDTH) {
+        $TERMINAL_WIDTH = &detectTerminalWidth();
+    }
+}
+sub setAttribute { # (type, prefox, postfix)
+    my ($type, $prefix, $postfix) = @_;
+    $ATTRIBUTE_PREFIX{$type} = $prefix;
+    $ATTRIBUTE_POSTFIX{$type} = $postfix;
+}
+sub stripAnsiEscapes { # (Line) -> (StrippedLine)
+    $_[0] =~ s/\e\[[^m]*m//g;
+    return $_[0];
+}
+sub getDefaultVerbosity { # () -> VerbosityLevel
+    # We can not print at correct verbosity levels before argument parsing has
+    # completed. We try some simple arg parsing here assuming default options
+    # used to set verbosity, such that we likely guess correctly, allowing
+    # correct verbosity from the start.
+    my $default = 3;
+    foreach my $arg (@ARGV) {
+        if ($arg eq '--') { return $default; }
+        if ($arg =~ /^-([^-]+)/) {
+            my $optstring = $1;
+            while ($optstring =~ /^(.)(.*)$/) {
+                my $char = $1;
+                $optstring = $2;
+                if ($char eq 'v') {
+                    ++$default;
+                }
+                if ($char eq 's') {
+                    if ($default > 0) {
+                        --$default;
+                    }
+                }
+            }
+        }
+    }
+    return $default;
+}
+sub detectTerminalWidth { #() -> ColumnCount
+    my $cols = &checkConsoleFeature('cols');
+    if (!defined $cols) {
+        printDebug "Assuming terminal width of 80.\n";
+        return 80;
+    }
+    if ($cols =~ /^\d+$/ && $cols > 10 && $cols < 500) {
+        printDebug "Detected terminal width of $cols.\n";
+        return $cols;
+    } else {
+        printDebug "Unexpected terminal width of '$cols' given. "
+                 . "Assuming size of 80.\n";
+        return 80;
+    }
+}
+sub detectTerminalColorSupport { # () -> Bool
+    my $colorcount = &checkConsoleFeature('colors');
+    if (!defined $colorcount) {
+        $ANSI_COLORS_SUPPORTED = 0;
+        printDebug "Assuming no color support.\n";
+        return 0;
+    }
+    if ($colorcount =~ /^\d+$/ && $colorcount >= 8) {
+        $ANSI_COLORS_SUPPORTED = 1;
+        if (!defined $ANSI_COLORS) {
+            $ANSI_COLORS = $ANSI_COLORS_SUPPORTED;
+        }
+        printDebug "Color support detected.\n";
+        return 1;
+    }
+}
+sub checkConsoleFeature { # (Feature) -> Bool
+    my ($feature) = @_;
+        # Unit tests must mock. Can't depend on TERM being set.
+    assertNotUnitTest();
+    if (!exists $ENV{'TERM'}) {
+        printDebug "Terminal not set. Unknown.\n";
+        return;
+    }
+    if (-f '/usr/bin/tput') {
+        my ($fh, $result);
+        if (open ($fh, "tput $feature 2>/dev/null |")) {
+            $result = <$fh>;
+            close $fh;
+        } else {
+            printDebug "Failed to open tput pipe.\n";
+            return;
+        }
+        if ($? != 0) {
+            printDebug "Failed tput call to detect feature $feature $!\n";
+            return;
+        }
+        chomp $result;
+        #printSpam "Console feature $feature: '$result'\n";
+        return $result;
+    } else {
+        printDebug "No tput binary. Dont know how to detect feature.\n";
+        return;
+    }
+}
+sub printAtLevel { # (Level, Output...)
+    # Prints an array of data that may contain newlines
+    my $level = shift @_;
+    exists $TYPES{$level} or confess "Unknown print level '$level'.";
+    if ($TYPES{$level} > $VERBOSITY) {
+        return;
+    }
+    my $buffer = '';
+    my $width = &getTerminalWidth();
+    foreach my $printable (@_) {
+        my @lines = split(/\n/, $printable, -1);
+        my $current = 0;
+        for (my $i=0; $i < scalar @lines; ++$i) {
+            if ($i != 0) {
+                $buffer .= "\n";
+                $COLUMN_POSITION = 0;
+            }
+            my $last = ($i + 1 == scalar @lines);
+            printLineAtLevel($level, $lines[$i], \$buffer, $last);
+        }
+    }
+    my $stream = $OUTPUT_STREAM{$level};
+    print $stream $buffer;
+}
+sub printLineAtLevel { # (Level, Line, Buffer, Last)
+    # Prints a single line, which might still have to be broken into multiple
+    # lines
+    my ($level, $data, $buffer, $last) = @_;
+    if (!$ANSI_COLORS) {
+        $data = &stripAnsiEscapes($data);
+    }
+    my $width = &getTerminalWidth();
+    while (1) {
+        my $remaining = $width - $COLUMN_POSITION;
+        if (&prefixLineWithLevel($level)) {
+            $remaining -= (2 + length $level);
+        }
+        if ($ENABLE_AUTO_LINE_BREAKS && $remaining < length $data) {
+            my $min = int (2 * $width / 3) - $COLUMN_POSITION;
+            if ($min < 1) { $min = 1; }
+            if ($data =~ /^(.{$min,$remaining}) (.*?)$/s) {
+                my ($first, $rest) = ($1, $2);
+                &printLinePartAtLevel($level, $first, $buffer);
+                $$buffer .= "\n";
+                $data = $rest;
+                $COLUMN_POSITION = 0;
+            } else {
+                last;
+            }
+        } else {
+            last;
+        }
+    }
+    if (!$last || length $data > 0) {
+        &printLinePartAtLevel($level, $data, $buffer);
+    }
+}
+sub printLinePartAtLevel { # ($Level, Line, Buffer)
+    # Print a single line that should fit on one line
+    my ($level, $data, $buffer) = @_;
+    if ($ANSI_COLORS) {
+        $$buffer .= $ATTRIBUTE_PREFIX{$level};
+    }
+    if (&prefixLineWithLevel($level)) {
+        $$buffer .= $level . ": ";
+        $COLUMN_POSITION = (length $level) + 2;
+    }
+    $$buffer .= $data;
+    $COLUMN_POSITION += length $data;
+    if ($ANSI_COLORS) {
+        $$buffer .= $ATTRIBUTE_POSTFIX{$level};
+    }
+}
+sub prefixLineWithLevel { # (Level) -> Bool
+    my ($level) = @_;
+    return ($TYPES{$level} > 2 && $VERBOSITY >= 4 && $COLUMN_POSITION == 0);
+}
+
diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/ContentNodeSelection.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/ContentNodeSelection.pm
new file mode 100644
index 00000000000..f5507ce478e
--- /dev/null
+++ b/vespaclient/src/perl/lib/Yahoo/Vespa/ContentNodeSelection.pm
@@ -0,0 +1,141 @@
+# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root.
+#
+# This module implements a way to select a subset of nodes from a Vespa
+# application.
+#
+
+package Yahoo::Vespa::ContentNodeSelection;
+
+use strict;
+use warnings;
+use Yahoo::Vespa::ArgParser;
+use Yahoo::Vespa::ConsoleOutput;
+use Yahoo::Vespa::Utils;
+use Yahoo::Vespa::VespaModel;
+
+BEGIN { # - Declare exports and dependency aliases for module
+    use base 'Exporter';
+    our @EXPORT = qw(
+        NO_LOCALHOST_CONSTRAINT
+        CLUSTER_ONLY_LIMITATION
+    );
+        # Package aliases
+    *VespaModel:: = *Yahoo::Vespa::VespaModel:: ;
+}
+
+my $CLUSTER;
+my $NODE_TYPE;
+my $INDEX;
+my $FORCE = 0;
+our $LOCALHOST;
+
+use constant NO_LOCALHOST_CONSTRAINT => 1;
+use constant CLUSTER_ONLY_LIMITATION => 2;
+
+return 1;
+
+######################## Externally usable functions #######################
+
+sub registerCommandLineArguments { # (Flags)
+    my ($flags) = @_;
+    if (!defined $flags) { $flags = 0; }
+    if (($flags & NO_LOCALHOST_CONSTRAINT) == 0) {
+        $LOCALHOST = getHostname();
+    } else {
+        $LOCALHOST = undef;
+    }
+    if (($flags & CLUSTER_ONLY_LIMITATION) == 0) {
+        setOptionHeader("Node selection options. By default, nodes running "
+                      . "locally will be selected:");
+    }
+    setStringOption(
+            ['c', 'cluster'],
+            \$CLUSTER,
+            'Cluster name of cluster to query. '
+          . 'If unspecified, and vespa is installed on current node, '
+          . 'information will be attempted auto-extracted');
+    setFlagOption(
+        ['f', 'force'],
+        \$FORCE,
+        'Force the execution of a dangerous command.');
+    if (($flags & CLUSTER_ONLY_LIMITATION) == 0) {
+        setStringOption(
+                ['t', 'type'],
+                \$NODE_TYPE,
+                'Node type to query. This can either be \'storage\' or '
+              . '\'distributor\'. If not specified, the operation will show '
+              . 'state for all types.');
+        setIntegerOption(
+                ['i', 'index'],
+                \$INDEX,
+                'The node index to show state for. If not specified, all nodes '
+              . 'found running on this host will be shown.');
+    }
+}
+sub visit { # (Callback)
+    my ($callback) = @_;
+    printDebug "Visiting selected services: "
+            . "Cluster " . (defined $CLUSTER ? $CLUSTER : 'undef')
+            . " node type " . (defined $NODE_TYPE ? $NODE_TYPE : 'undef')
+            . " index " . (defined $INDEX ? $INDEX : 'undef')
+            . " localhost only ? " . ($LOCALHOST ? "true" : "false") . "\n";
+    VespaModel::visitServices(sub {
+        my ($info) = @_;
+        $$info{'type'} = &convertType($$info{'type'});
+        if (!&validType($$info{'type'})) { return; }
+        if (defined $CLUSTER && $CLUSTER ne $$info{'cluster'}) { return; }
+        if (defined $NODE_TYPE && $NODE_TYPE ne $$info{'type'}) { return; }
+        if (defined $INDEX && $INDEX ne $$info{'index'}) { return; }
+        if (!defined $INDEX && defined $LOCALHOST
+            && $LOCALHOST ne $$info{'host'})
+        {
+            return;
+        }
+       # printResult "Ok $$info{'cluster'} $$info{'type'} $$info{'index'}\n";
+        &$callback($info);
+    });
+}
+sub showSettings { # ()
+    printDebug "Visiting selected services: "
+            . "Cluster " . (defined $CLUSTER ? $CLUSTER : 'undef')
+            . " node type " . (defined $NODE_TYPE ? $NODE_TYPE : 'undef')
+            . " index " . (defined $INDEX ? $INDEX : 'undef')
+            . " localhost only ? " . ($LOCALHOST ? "true" : "false") . "\n";
+}
+
+sub validateCommandLineArguments { # (WantedState)
+    my ($wanted_state) = @_;
+
+    if (defined $NODE_TYPE) {
+        if ($NODE_TYPE !~ /^(distributor|storage)$/) {
+            printWarning "Invalid value '$NODE_TYPE' given for node type.\n";
+            return 0;
+        }
+    }
+
+    if (!$FORCE &&
+        (!defined $NODE_TYPE || $NODE_TYPE eq "distributor") &&
+        $wanted_state eq "maintenance") {
+        printWarning "Setting the distributor to maintenance mode may have "
+            . "severe consequences for feeding!\n"
+            . "Please specify -t storage to only set the storage node to "
+            . "maintenance mode, or -f to override this error.\n";
+        return 0;
+    }
+
+    printDebug "Command line arguments validates ok\n";
+    return 1;
+}
+
+############## Utility functions - Not intended for external use #############
+
+sub validType { # (ServiceType) -> Bool
+    my ($type) = @_;
+    return $type =~ /^(?:distributor|storage)$/;
+}
+sub convertType { # (ServiceType) -> Bool
+    my ($type) = @_;
+    if ($type eq 'storagenode') { return 'storage'; }
+    return $type;
+}
+
diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/Http.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/Http.pm
new file mode 100644
index 00000000000..8e25442a64d
--- /dev/null
+++ b/vespaclient/src/perl/lib/Yahoo/Vespa/Http.pm
@@ -0,0 +1,160 @@
+# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root.
+#
+# Simple HTTP wrapper library
+#
+# Intentions:
+#   - Make it very easy for programs to do HTTP requests towards Rest APIs.
+#   - Allow unit tests to fake returned data
+#   - Allow using another external dependency for HTTP without affecting apps
+#
+# An HTTP request returns a Response that is a hash containing:
+#   code - The HTTP status code
+#   status - The HTTP status string that comes with the code
+#   content - The content of the reply
+#   all - The entire response coming over the TCP connection
+#         This is here for debugging and testing. If you need specifics like
+#         HTTP headers, we should just add specific fields for them rather than
+#         to parse all content.
+#
+# Examples:
+#
+# my @headers = (
+#     "X-Foo" => 'Bar'
+# );
+# my @params = (
+#     "verbose" => 1
+# );
+# 
+# $response = Http::get('localhost', 80, '/status.html');
+# $response = Http::get('localhost', 80, '/status.html', \@params, \@headers);
+# $response = Http::request('POST', 'localhost', 80, '/test', \@params,
+#                           "Some content", \@headers);
+# 
+
+package Yahoo::Vespa::Http;
+
+use strict;
+use warnings;
+
+use Net::INET6Glue::INET_is_INET6;
+use LWP::Simple ();
+use URI ();
+use URI::Escape qw( uri_escape );
+use Yahoo::Vespa::ConsoleOutput;
+use Yahoo::Vespa::Utils;
+
+my %LEGAL_TYPES;
+my $BROWSER;
+my $EXECUTE;
+
+&initialize();
+
+return 1;
+
+######################## Externally usable functions #######################
+
+sub get { # (Host, Port, Path, Params, Headers) -> Response
+    my ($host, $port, $path, $params, $headers) = @_;
+    return &request('GET', $host, $port, $path, $params, undef, $headers);
+}
+sub request { # (Type, Host, Port, Path, Params, Content, Headers) -> Response
+    my ($type, $host, $port, $path, $params, $content, $headers) = @_;
+    if (!exists $LEGAL_TYPES{$type}) {
+        confess "Invalid HTTP type '$type' specified.";
+    }
+    if (defined $params && ref($params) ne "ARRAY") {
+        confess 'HTTP request attempted without array ref for params';
+    }
+    if (defined $headers && ref($headers) ne "ARRAY") {
+        confess 'HTTP request attempted without array ref for headers';
+    }
+    return &$EXECUTE(
+            $type, $host, $port, $path, $params, $content, $headers);
+}
+sub encodeForm { # (KeyValueMap) -> RawString
+    my $data;
+    for (my $i=0; $i < scalar @_; $i += 2) {
+        my ($key, $value) = ($_[$i], $_[$i+1]);
+        if ($i != 0) {
+            $data .= '&';
+        }
+        $data .= uri_escape($key);
+        if (defined $value) {
+            $data .= '=' . uri_escape($value);
+        }
+    }
+    return $data;
+}
+
+################## Functions for unit tests to mock internals ################
+
+sub setHttpExecutor { # (Function)
+    $EXECUTE = $_[0]
+}
+
+############## Utility functions - Not intended for external use #############
+
+sub initialize { # ()
+    %LEGAL_TYPES = map { $_ => 1 } ( 'GET', 'POST', 'PUT', 'DELETE');
+    $BROWSER = LWP::UserAgent->new;
+    $BROWSER->agent('Vespa-perl-script');
+    $EXECUTE = \&execute;
+}
+sub execute { # (Type, Host, Port, Path, Params, Content, Headers) -> Response
+    my ($type, $host, $port, $path, $params, $content, $headers) = @_;
+    if (!defined $headers) { $headers = []; }
+    if (!defined $params) { $params = []; }
+    my $url = URI->new(&buildUri($host, $port, $path));
+    if (defined $params) {
+        $url->query_form(@$params);
+    }
+    printSpam "Performing HTTP request $type '$url'.\n";
+    my $response;
+    if ($type eq 'GET') {
+        !defined $content or confess "$type requests cannot have content";
+        $response = $BROWSER->get($url, @$headers);
+    } elsif ($type eq 'POST') {
+        if (defined $content) {
+            $response = $BROWSER->post($url, $params, @$headers,
+                                       'Content' => $content);
+        } else {
+            $response = $BROWSER->post($url, $params, @$headers);
+        }
+    } elsif ($type eq 'PUT') {
+        if (defined $content) {
+            $response = $BROWSER->put($url, $params, @$headers,
+                                     'Content' => $content);
+        } else {
+            $response = $BROWSER->put($url, $params, @$headers);
+        }
+    } elsif ($type eq 'DELETE') {
+        !defined $content or confess "$type requests cannot have content";
+        $response = $BROWSER->put($url, $params, @$headers);
+    } else {
+        confess "Unknown type $type";
+    }
+    my $autoLineBreak = enableAutomaticLineBreaks(0);
+    printSpam "Got HTTP result: '" . $response->as_string . "'\n";
+    enableAutomaticLineBreaks($autoLineBreak);
+    return (
+        'code' => $response->code,
+        'headers' => $response->headers(),
+        'status' => $response->message,
+        'content' => $response->content,
+        'all' => $response->as_string
+    );
+}
+sub buildUri { # (Host, Port, Path) -> UriString
+    my ($host, $port, $path) = @_;
+    my $uri = "http:";
+    if (defined $host) {
+        $uri .= '//' . $host;
+        if (defined $port) {
+            $uri .= ':' . $port;
+        }
+    }
+    if (defined $path) {
+        $uri .= $path;
+    }
+    return $uri;
+}
diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/Json.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/Json.pm
new file mode 100644
index 00000000000..8acadbe59ae
--- /dev/null
+++ b/vespaclient/src/perl/lib/Yahoo/Vespa/Json.pm
@@ -0,0 +1,52 @@
+# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root.
+#
+# Minimal JSON wrapper.
+#
+# Intentions:
+#   - If needed, be able to switch the implementation of the JSON parser
+#     without components using this class seeing it.
+#   - Make API as simple as possible to use.
+#
+# Currently uses JSON.pm from ypan/perl-JSON
+#
+# Example usage:
+#
+# my $json = <<EOS;
+# {
+#   'foo' : [
+#     { 'key1' : 2 },
+#     { 'key2' : 5 }
+#   ]
+# }
+#
+# my $result = Json::parse($json);
+# my $firstkey = $result->{'foo'}->[0]->{'key1'}
+# my @keys = @{ $result->{'foo'} };
+#
+# See JsonTest for more usage. Add tests there if unsure.
+#
+
+package Yahoo::Vespa::Json;
+
+use strict;
+use warnings;
+    # Location of JSON.pm is not in default search path on tested Yahoo nodes.
+use lib ($ENV{'VESPA_HOME'} . '/lib64/perl5/site_perl/5.14/');
+use JSON;
+
+return 1;
+
+# Parses a string with json data returning an object tree
+sub parse { # (RawString) -> ObjTree
+    my ($raw) = @_;
+    my $json = decode_json($raw);
+    return $json;
+}
+
+# Encodes an object tree as returned from parse back to a raw string
+sub encode { # (ObjTree) -> RawString
+    my ($json) = @_;
+    my $JSON = JSON->new->allow_nonref;
+    my $encoded = $JSON->pretty->encode($json);
+    return $encoded;
+}
diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/Utils.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/Utils.pm
new file mode 100644
index 00000000000..63e1a3093bc
--- /dev/null
+++ b/vespaclient/src/perl/lib/Yahoo/Vespa/Utils.pm
@@ -0,0 +1,97 @@
+# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root.
+#
+# Some simple utilities to allow unit tests to mock behavior.
+#
+
+package Yahoo::Vespa::Utils;
+
+use strict;
+use warnings;
+use Carp ();
+use Sys::Hostname qw(hostname);
+
+BEGIN { # - Define exports from this module
+    use base 'Exporter';
+    our @EXPORT = qw(
+        exitApplication
+        getHostname
+        confess
+        assertNotUnitTest
+        dumpStructure
+    );
+}
+
+my $HOSTNAME;
+my $EXIT_HANDLER;
+my $IS_UNIT_TEST;
+
+&initialize();
+
+return 1;
+
+########################## Default exported functions ########################
+
+# Use this function to get hostname to allow unit test mocking for tests to be
+# independent of computer they run on.
+sub getHostname { # ()
+    if (!defined $HOSTNAME) {
+        $HOSTNAME = hostname;
+        &assertNotUnitTest();
+        $HOSTNAME = `hostname`;
+        chomp $HOSTNAME;
+    }
+    return $HOSTNAME;
+}
+
+# Use instead of exit() to allow unit tests to mock the call to avoid aborting
+sub exitApplication { #(ExitCode)
+    if ($IS_UNIT_TEST && $EXIT_HANDLER == \&defaultExitHandler) {
+        &confess("Exit handler not overridden in unit test");
+    }
+    &$EXIT_HANDLER(@_);
+}
+
+# Use instead of die to get backtrace when dieing
+sub confess { # (Reason)
+    Carp::confess(@_);
+}
+
+# Call for behavior that you want to ensure is not used in unit tests.
+# Typically unit tests have to mock commands that for instance fetch host name
+# or require that terminal is set etc. Unit tests use mocks for this. This
+# command can be used in code, such that unit tests die if they reach the
+# non-mocked code.
+sub assertNotUnitTest { # ()
+    if ($IS_UNIT_TEST) {
+        confess "Unit tests should not reach here. Mock required. "
+              . "Initialize mock";
+    }
+}
+
+# Use to look at content of a perl struct.
+sub dumpStructure { # (ObjTree) -> ReadableString
+    my ($var) = @_;
+    use Data::Dumper;
+    local $Data::Dumper::Indent = 1;
+    local $Data::Dumper::Sortkeys = 1;
+    return Dumper($var);
+}
+
+################## Functions for unit tests to mock internals ################
+
+sub initializeUnitTest { # (Hostname, ExitHandler)
+    my ($host, $exitHandler) = @_;
+    $IS_UNIT_TEST = 1;
+    $HOSTNAME = $host;
+    $EXIT_HANDLER = $exitHandler;
+}
+
+############## Utility functions - Not intended for external use #############
+
+sub initialize { # ()
+    $EXIT_HANDLER = \&defaultExitHandler;
+}
+sub defaultExitHandler { # ()
+    my ($exitcode) = @_;
+    exit($exitcode);
+}
diff --git a/vespaclient/src/perl/lib/Yahoo/Vespa/VespaModel.pm b/vespaclient/src/perl/lib/Yahoo/Vespa/VespaModel.pm
new file mode 100644
index 00000000000..9e1fd90eeb3
--- /dev/null
+++ b/vespaclient/src/perl/lib/Yahoo/Vespa/VespaModel.pm
@@ -0,0 +1,350 @@
+# Copyright 2016 Yahoo Inc. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root.
+#
+# Vespa model
+#
+# Make vespa model information available for tools. To for instance get an
+# overview of where services are running.
+#
+# Possible improvements:
+#
+#   - Depending on config Rest API and config server might be better than
+#     depending on getvespaconfig tool and config format.
+#   - Support direct communication with config server if config proxy is not
+#     running (unless getvespaconfig does that for us)
+#   - Support specifying config server, to be able to run tool external from the
+#     vespa system to talk to.
+#   - Return a list of all matching sockets instead of first found.
+#   - Be able to specify a set of port tags needed for a match.
+#
+
+package Yahoo::Vespa::VespaModel;
+
+use strict;
+use warnings;
+use Yahoo::Vespa::ArgParser;
+use Yahoo::Vespa::ConsoleOutput;
+use Yahoo::Vespa::Utils;
+
+my $RETRIEVE_MODEL_CONFIG; # Allow unit tests to switch source of config info
+my $MODEL;
+my $CONFIG_SERVER_HOST;
+my $CONFIG_SERVER_PORT;
+my $CONFIG_REQUEST_TIMEOUT;
+
+&initialize();
+
+return 1;
+
+######################## Externally usable functions #######################
+
+sub registerCommandLineArguments { # ()
+    setOptionHeader("Config retrieval options:");
+    setHostOption(
+            ['config-server'],
+            \$CONFIG_SERVER_HOST,
+            'Host name of config server to query');
+    setPortOption(
+            ['config-server-port'],
+            \$CONFIG_SERVER_PORT,
+            'Port to connect to config server on');
+    setFloatOption(
+            ['config-request-timeout'],
+            \$CONFIG_REQUEST_TIMEOUT,
+            'Timeout of config request');
+}
+
+sub visitServices { # (Callback)
+    my $model = &get();
+    my ($callback) = @_;
+    my @services = @{ &getServices($model); };
+    foreach my $service (sort serviceOrder @services) {
+        &$callback($service);
+    }
+}
+
+sub getServices {
+    my $model = &get();
+    my @result;
+    foreach my $hostindex (keys %{ $$model{'hosts'} }) {
+        my $host = ${ $$model{'hosts'} }{ $hostindex };
+        foreach my $serviceindex (keys %{ $$host{'services'} }) {
+            my $service = ${ $$host{'services'} }{ $serviceindex };
+            my %info = (
+                'name' => $$service{'name'},
+                'type' => $$service{'type'},
+                'configid' => $$service{'configid'},
+                'cluster' => $$service{'clustername'},
+                'host' => $$host{'name'}
+            );
+            if (exists $$service{'index'}) {
+                $info{'index'} = $$service{'index'};
+            }
+            push @result, \%info;
+        }
+    }
+    return \@result;
+}
+
+# Get socket for given service matching given conditions (Given as a hash)
+# Legal conditions:
+#   type - Service type
+#   tag - Port tag
+#   index - Service index
+#   clustername - Name of cluster.
+# Example: getSocketForService( 'type' => 'distributor', 'index' => 3,
+#                               'tag' => 'http', 'tag' => 'state' );
+sub getSocketForService { # (Conditions) => [{host=>$,port=>$,index=>$}...]
+    my $model = &get();
+    my $conditions = \@_;
+    printDebug "Looking at model to find socket for a service.\n";
+    &validateConditions($conditions);
+    my $hosts = $$model{'hosts'};
+    if (!defined $hosts) { return; }
+    my @results;
+    foreach my $hostindex (keys %$hosts) {
+        my $host = $$hosts{$hostindex};
+        my $services = $$host{'services'};
+        if (defined $services) {
+            printSpam "Searching services on host $$host{'name'}\n";
+            foreach my $serviceindex (keys %$services) {
+                my $service = $$services{$serviceindex};
+                my $type = $$service{'type'};
+                my $cluster = $$service{'clustername'};
+                if (!&serviceTypeMatchConditions($conditions, $type)) {
+                    printSpam "Unwanted service '$type'.\n";
+                    next;
+                }
+                if (!&indexMatchConditions($conditions, $$service{'index'})) {
+                    printSpam "Unwanted index '$$service{'index'}'.\n";
+                    next;
+                }
+                if (!&clusterNameMatchConditions($conditions, $cluster)) {
+                    printSpam "Unwanted index '$$service{'index'}'.\n";
+                    next;
+                }
+                my $ports = $$service{'ports'};
+                if (defined $ports) {
+                    my $resultcount = 0;
+                    foreach my $portindex (keys %$ports) {
+                        my $port = $$ports{$portindex};
+                        my $tags = $$port{'tags'};
+                        if (defined $tags) {
+                            if (!&tagsMatchConditions($conditions, $tags)) {
+                                next;
+                            }
+                        }
+                        push @results, { 'host' => $$host{'name'},
+                                         'port' => $$port{'number'},
+                                         'index' => $$service{'index'} };
+                        ++$resultcount;
+                    }
+                    if ($resultcount == 0) {
+                        printSpam "No ports with acceptable tags found. "
+                                . "Ignoring $type.$$service{'index'}\n";
+                    }
+                } else {
+                    printSpam "No ports defined. "
+                            . "Ignoring $type.$$service{'index'}\n";
+                }
+            }
+        }
+    }
+    return \@results;
+}
+
+############## Utility functions - Not intended for external use #############
+
+sub initialize { # ()
+    $RETRIEVE_MODEL_CONFIG = \&retrieveModelConfigDefault;
+}
+sub setModelRetrievalFunction { # (Function)
+    $RETRIEVE_MODEL_CONFIG = $_[0];
+}
+sub retrieveModelConfigDefault { # ()
+    my $VESPA_HOME= $ENV{'VESPA_HOME'};
+    my $cmd = ${VESPA_HOME} . '/bin/getvespaconfig -n cloud.config.model -i admin/model';
+
+    if (defined $CONFIG_REQUEST_TIMEOUT) {
+        $cmd .= " -w $CONFIG_REQUEST_TIMEOUT";
+    }
+
+    my $temp = `${VESPA_HOME}/libexec/vespa/vespa-config.pl -configsources`;
+    my @configSources = split(",", $temp);
+    my $firstConfigSource = $configSources[0];
+    if (!defined $CONFIG_SERVER_HOST) {
+        my @temp = split('/', $firstConfigSource);
+        my @configHost = split(':', $temp[1]);
+        $CONFIG_SERVER_HOST = $configHost[0];
+    }
+    $cmd .= " -s $CONFIG_SERVER_HOST";
+
+    if (!defined $CONFIG_SERVER_PORT) {
+        my @configPort = split(':', $firstConfigSource);
+        $CONFIG_SERVER_PORT = $configPort[1];
+    }
+    $cmd .= " -p $CONFIG_SERVER_PORT";
+
+    printDebug "Fetching model config '$cmd'.\n";
+    my @data = `$cmd 2>&1`;
+    if ($? != 0 || join(' ', @data) =~ /^error/) {
+        printError "Failed to get model config from config command line tool:\n"
+                 . "Command: $cmd\n"
+                 . "Exit code: $?\n"
+                 . "Output: " . join("\n", @data) . "\n";
+        exitApplication(1);
+    }
+    return @data;
+}
+sub fetch { # ()
+    my @data = &$RETRIEVE_MODEL_CONFIG();
+    $MODEL = &parseConfig(@data);
+    return $MODEL;
+}
+sub get { # ()
+    if (!defined $MODEL) {
+        return &fetch();
+    }
+    return $MODEL;
+}
+sub validateConditions { # (ConditionArrayRef)
+    my ($condition) = @_;
+    for (my $i=0, my $n=scalar @$condition; $i<$n; $i += 2) {
+        if ($$condition[$i] !~ /^(type|tag|index|clustername)$/) {
+            printError "Invalid socket for service condition "
+                     . "'$$condition[$i]' given.\n";
+            exitApplication(1);
+        }
+    }
+}
+sub tagsMatchConditions { # (Condition, TagList) -> Bool
+    my ($condition, $taglist) = @_;
+    my %tags = map { $_ => 1 } @$taglist;
+    for (my $i=0, my $n=scalar @$condition; $i<$n; $i += 2) {
+        if ($$condition[$i] eq 'tag' && !exists $tags{$$condition[$i + 1]}) {
+            return 0;
+        }
+    }
+    return 1;
+}
+sub serviceTypeMatchConditions { # (Condition, ServiceType) -> Bool
+    my ($condition, $type) = @_;
+    for (my $i=0, my $n=scalar @$condition; $i<$n; $i += 2) {
+        if ($$condition[$i] eq 'type' && $$condition[$i + 1] ne $type) {
+            return 0;
+        }
+    }
+    return 1;
+}
+sub clusterNameMatchConditions { # (Condition, ClusterName) -> Bool
+    my ($condition, $cluster) = @_;
+    for (my $i=0, my $n=scalar @$condition; $i<$n; $i += 2) {
+        if ($$condition[$i] eq 'clustername' && $$condition[$i + 1] ne $cluster)
+        {
+            return 0;
+        }
+    }
+    return 1;
+}
+sub indexMatchConditions { # (Condition, Index) -> Bool
+    my ($condition, $index) = @_;
+    for (my $i=0, my $n=scalar @$condition; $i<$n; $i += 2) {
+        if ($$condition[$i] eq 'index' && $$condition[$i + 1] ne $index) {
+            return 0;
+        }
+    }
+    return 1;
+}
+sub parseConfig { # ()
+    my $model = {};
+    printDebug "Parsing vespa model raw config to create object tree\n";
+    my $autoLineBreak = enableAutomaticLineBreaks(0);
+    foreach my $line (@_) {
+        chomp $line;
+        printSpam "Parsing line '$line'\n";
+        if ($line =~ /^hosts\[(\d+)\]\.(([a-z]+).*)$/) {
+            my ($hostindex, $tag, $rest) = ($1, $3, $2);
+            my $host = &getHost($hostindex, $model);
+            if ($tag eq 'services') {
+                &parseService($host, $rest);
+            } else {
+                &parseValue($host, $rest);
+            }
+        }
+    }
+    enableAutomaticLineBreaks($autoLineBreak);
+    return $model;
+}
+sub parseService { # (Host, Line)
+    my ($host, $line) = @_;
+    if ($line =~ /^services\[(\d+)\].(([a-z]+).*)$/) {
+        my ($serviceindex, $tag, $rest) = ($1, $3, $2);
+        my $service = &getService($serviceindex, $host);
+        if ($tag eq 'ports') {
+            &parsePort($service, $rest);
+        } else {
+            &parseValue($service, $rest);
+        }
+    }
+}
+sub parsePort { # (Service, Line)
+    my ($service, $line) = @_;
+    if ($line =~ /^ports\[(\d+)\].(([a-z]+).*)$/) {
+        my ($portindex, $tag, $rest) = ($1, $3, $2);
+        my $port = &getPort($portindex, $service);
+        &parseValue($port, $rest);
+    }
+}
+sub parseValue { # (Entity, Line)
+    my ($entity, $line) = @_;
+    $line =~ /^(\S+) (?:\"(.*)\"|(\d+))$/ or confess "Unexpected line '$line'.";
+    my ($id, $string, $number) = ($1, $2, $3);
+    if ($id eq 'tags' && defined $string) {
+        my @tags = split(/\s+/, $string);
+        $$entity{$id} = \@tags;
+    } elsif (defined $string) {
+        $$entity{$id} = $string;
+    } else {
+        defined $number or confess "Should not happen";
+        $$entity{$id} = $number;
+    }
+}
+sub getEntity { # (Type, Index, ParentEntity)
+    my ($type, $index, $parent) = @_;
+    if (!exists $$parent{$type}) {
+        $$parent{$type} = {};
+    }
+    my $list = $$parent{$type};
+    if (!exists $$list{$index}) {
+        $$list{$index} = {};
+    }
+    return $$list{$index};
+}
+sub getHost { # (Index, Model)
+    return &getEntity('hosts', $_[0], $_[1]);
+}
+sub getService { # (Index, Host)
+    return &getEntity('services', $_[0], $_[1]);
+}
+sub getPort { # (Index, Service)
+    return &getEntity('ports', $_[0], $_[1]);
+}
+sub serviceOrder {
+    if ($a->{'cluster'} ne $b->{'cluster'}) {
+        return $a->{'cluster'} cmp $b->{'cluster'};
+    }
+    if ($a->{'type'} ne $b->{'type'}) {
+        return $a->{'type'} cmp $b->{'type'};
+    }
+    if ($a->{'index'} != $b->{'index'}) {
+        return $a->{'index'} <=> $b->{'index'};
+    }
+    if ($a->{'host'} ne $b->{'host'}) {
+        return $a->{'host'} cmp $b->{'host'};
+    }
+    if ($a->{'configid'} ne $b->{'configid'}) {
+        return $a->{'configid'} cmp $b->{'configid'};
+    }
+    confess "Unsortable elements: " . dumpStructure($a) . "\n"
+                                    . dumpStructure($b) . "\n";
+}
+