summaryrefslogtreecommitdiffstats
path: root/vespaclient/src/perl/lib/Yahoo/Vespa/VespaModel.pm
diff options
context:
space:
mode:
Diffstat (limited to 'vespaclient/src/perl/lib/Yahoo/Vespa/VespaModel.pm')
-rw-r--r--vespaclient/src/perl/lib/Yahoo/Vespa/VespaModel.pm350
1 files changed, 350 insertions, 0 deletions
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";
+}
+