diff --git a/bin/pt-agent b/bin/pt-agent index 19f9ac59..b621b728 100755 --- a/bin/pt-agent +++ b/bin/pt-agent @@ -696,24 +696,26 @@ our @EXPORT_OK = qw( ); sub as_hashref { - my $resource = shift; + my ($resource, %args) = @_; my $as_hashref = { %$resource }; - delete $as_hashref->{links}; + if ( !defined $args{with_links} || !$args{with_links} ) { + delete $as_hashref->{links}; + } return $as_hashref; } sub as_json { - my $resource = shift; + my ($resource, %args) = @_; - my $json = JSON->new; + my $json = $args{json} || JSON->new; $json->allow_blessed([]); $json->convert_blessed([]); return $json->encode( - ref $resource eq 'ARRAY' ? $resource : as_hashref($resource) + ref $resource eq 'ARRAY' ? $resource : as_hashref($resource, %args) ); } @@ -774,20 +776,13 @@ has 'api_key' => ( required => 1, ); -has 'base_url' => ( +has 'entry_link' => ( is => 'rw', isa => 'Str', default => sub { return 'https://api.tools.percona.com' }, required => 0, ); -has 'links' => ( - is => 'rw', - isa => 'HashRef', - lazy => 1, - default => sub { return +{} }, -); - has 'ua' => ( is => 'rw', isa => 'Object', @@ -807,45 +802,23 @@ sub _build_ua { my $self = shift; my $ua = LWP::UserAgent->new; $ua->agent("Percona::WebAPI::Client/$Percona::WebAPI::Client::VERSION"); - $ua->default_header('application/json'); + $ua->default_header('Content-Type', 'application/json'); $ua->default_header('X-Percona-API-Key', $self->api_key); return $ua; } -sub BUILD { - my ($self) = @_; - - eval { - $self->get( - url => $self->base_url, - ); - }; - if ( my $e = $EVAL_ERROR ) { - if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) { - die $e; - } - else { - die "Unknown error: $e"; - } - } - - return; -} - sub get { my ($self, %args) = @_; have_required_args(\%args, qw( - url + link )) or die; - my ($url) = $args{url}; - - my @resources; + my ($link) = $args{link}; eval { $self->_request( method => 'GET', - url => $url, + link => $link, ); }; if ( my $e = $EVAL_ERROR ) { @@ -857,7 +830,7 @@ sub get { } } - my $res = eval { + my $resource = eval { decode_json($self->response->content); }; if ( $EVAL_ERROR ) { @@ -867,21 +840,21 @@ sub get { return; } - my $objs; + my $resource_objects; if ( my $type = $self->response->headers->{'x-percona-resource-type'} ) { eval { - my $type = "Percona::WebAPI::Resource::$type"; - - if ( ref $res eq 'ARRAY' ) { + $type = "Percona::WebAPI::Resource::$type"; + if ( ref $resource eq 'ARRAY' ) { PTDEBUG && _d('Got a list of', $type, 'resources'); - foreach my $attribs ( @$res ) { + $resource_objects = []; + foreach my $attribs ( @$resource ) { my $obj = $type->new(%$attribs); - push @$objs, $obj; + push @$resource_objects, $obj; } } else { - PTDEBUG && _d('Got a', $type, 'resource'); - $objs = $type->new(%$res); + PTDEBUG && _d('Got a', $type, 'resource', Dumper($resource)); + $resource_objects = $type->new(%$resource); } }; if ( $EVAL_ERROR ) { @@ -889,44 +862,46 @@ sub get { return; } } - elsif ( $res ) { - $self->update_links($res); + elsif ( exists $resource->{links} ) { + $resource_objects = $resource->{links}; } else { - warn "Did not get X-Percona-Resource-Type or content from $url\n"; + warn "Did not get X-Percona-Resource-Type or links from $link\n"; } - return $objs; + return $resource_objects; } sub post { my $self = shift; - return $self->_set( + $self->_set( @_, method => 'POST', ); + return $self->response->header('Location'); } sub put { my $self = shift; - return $self->_set( + $self->_set( @_, method => 'PUT', ); + return; } sub delete { my ($self, %args) = @_; have_required_args(\%args, qw( - url + link )) or die; - my ($url) = $args{url}; + my ($link) = $args{link}; eval { $self->_request( method => 'DELETE', - url => $url, + link => $link, headers => { 'Content-Length' => 0 }, ); }; @@ -948,11 +923,11 @@ sub _set { have_required_args(\%args, qw( method resources - url + link )) or die; my $method = $args{method}; my $res = $args{resources}; - my $url = $args{url}; + my $link = $args{link}; my $content = ''; if ( ref($res) eq 'ARRAY' ) { @@ -983,7 +958,7 @@ sub _set { eval { $self->_request( method => $method, - url => $url, + link => $link, content => $content, ); }; @@ -996,18 +971,6 @@ sub _set { } } - my $response = eval { - decode_json($self->response->content); - }; - if ( $EVAL_ERROR ) { - warn sprintf "Error decoding response to $method $url: %s: %s", - $self->response->content, - $EVAL_ERROR; - return; - } - - $self->update_links($response); - return; } @@ -1016,10 +979,10 @@ sub _request { have_required_args(\%args, qw( method - url + link )) or die; my $method = $args{method}; - my $url = $args{url}; + my $link = $args{link}; my @optional_args = ( 'content', @@ -1027,12 +990,12 @@ sub _request { ); my ($content, $headers) = @args{@optional_args}; - my $req = HTTP::Request->new($method => $url); + my $req = HTTP::Request->new($method => $link); $req->content($content) if $content; if ( uc($method) eq 'DELETE' ) { $self->ua->default_header('Content-Length' => 0); } - PTDEBUG && _d('Request', $method, $url, Dumper($req)); + PTDEBUG && _d('Request', $method, $link, Dumper($req)); my $response = $self->ua->request($req); PTDEBUG && _d('Response', Dumper($response)); @@ -1044,10 +1007,10 @@ sub _request { if ( !($response->code >= 200 && $response->code < 400) ) { die Percona::WebAPI::Exception::Request->new( method => $method, - url => $url, + url => $link, content => $content, status => $response->code, - error => "Failed to $method $url" + error => "Failed to $method $link", ); } @@ -1056,16 +1019,6 @@ sub _request { return; } -sub update_links { - my ($self, $links) = @_; - return unless $links && ref $links && scalar keys %$links; - while (my ($rel, $link) = each %$links) { - $self->links->{$rel} = $link; - } - PTDEBUG && _d('Updated links', Dumper($self->links)); - return; -} - no Lmo; 1; } @@ -1161,7 +1114,13 @@ has 'versions' => ( is => 'ro', isa => 'Maybe[HashRef]', required => 0, - default => undef, +); + +has 'links' => ( + is => 'rw', + isa => 'Maybe[HashRef]', + required => 0, + default => sub { return {} }, ); no Lmo; @@ -1184,12 +1143,31 @@ package Percona::WebAPI::Resource::Config; use Lmo; +has 'id' => ( + is => 'r0', + isa => 'Int', + required => 1, +); + +has 'name' => ( + is => 'ro', + isa => 'Str', + required => 1, +); + has 'options' => ( is => 'ro', isa => 'HashRef', required => 1, ); +has 'links' => ( + is => 'rw', + isa => 'Maybe[HashRef]', + required => 0, + default => sub { return {} }, +); + no Lmo; 1; } @@ -1234,6 +1212,13 @@ has 'spool_schedule' => ( required => 0, ); +has 'links' => ( + is => 'rw', + isa => 'Maybe[HashRef]', + required => 0, + default => sub { return {} }, +); + sub BUILDARGS { my ($class, %args) = @_; if ( ref $args{runs} eq 'ARRAY' ) { @@ -1289,7 +1274,6 @@ has 'query' => ( is => 'ro', isa => 'Maybe[Str]', required => 0, - default => undef, ); has 'output' => ( @@ -4028,24 +4012,26 @@ use Time::Local qw(timegm timelocal); use Digest::MD5 qw(md5_hex); use B qw(); -require Exporter; -our @ISA = qw(Exporter); -our %EXPORT_TAGS = (); -our @EXPORT = (); -our @EXPORT_OK = qw( - micro_t - percentage_of - secs_to_time - time_to_secs - shorten - ts - parse_timestamp - unix_timestamp - any_unix_timestamp - make_checksum - crc32 - encode_json -); +BEGIN { + require Exporter; + our @ISA = qw(Exporter); + our %EXPORT_TAGS = (); + our @EXPORT = (); + our @EXPORT_OK = qw( + micro_t + percentage_of + secs_to_time + time_to_secs + shorten + ts + parse_timestamp + unix_timestamp + any_unix_timestamp + make_checksum + crc32 + encode_json + ); +} our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/; our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/; @@ -4424,7 +4410,7 @@ sub main { $o->usage_or_errors(); # ######################################################################## - # Check the API key and agent ID. + # Nothing works without an API key. # ######################################################################## my $api_key = $o->get('api-key'); if ( !$api_key ) { @@ -4433,13 +4419,6 @@ sub main { . "in a --config file or specify it with --api-key."); } - my $agent_id = $o->get('agent-id'); - if ( ($o->get('run-service') || $o->get('send-data')) && !$agent_id ) { - _err("No agent ID was found or specified. --run-service and " - . "--send-data require an agent ID. Run pt-agent without these " - . "options to create and configure the agent, then try again."); - } - # ######################################################################## # --run-service # This runs locally and offline, doesn't need a web API connection. @@ -4454,38 +4433,9 @@ sub main { exit $exit_status; } - # ######################################################################## - # Connect to the Percona web API. - # ######################################################################## - my ($client, $agent) = connect_to_percona( - api_key => $api_key, - agent_id => $agent_id, # optional - ); - - # ######################################################################## - # --send-data - # ######################################################################## - if ( my $service = $o->get('send-data') ) { - # TODO: rewrite Daemon to have args passed in so we can do - # a PID file check for spool procs. Or implement file locking. - send_data( - client => $client, - agent => $agent, - service => $service, - spool_dir => $o->get('spool'), - ); - _info("Done checking spool, exit $exit_status"); - exit $exit_status; - } - - # ######################################################################## - # This is the main pt-agent daemon, a long-running and resilient - # process. Only internal errors should cause it to stop. Else, - # external errors, like Percona web API not responding, should be - # retried forever. - # ######################################################################## - + # ######################################################################## # Daemonize first so all output goes to the --log. + # ######################################################################## my $daemon; if ( $o->get('daemonize') ) { $daemon = new Daemon(o=>$o); @@ -4497,6 +4447,45 @@ sub main { $daemon->make_PID_file(); } + # ######################################################################## + # Connect to the Percona web API. + # ######################################################################## + my ($client, $agent); + eval { + ($client, $agent) = connect_to_percona( + api_key => $api_key, + lib_dir => $o->get('lib'), + ); + }; + if ( $EVAL_ERROR ) { + PTDEBUG && _d($EVAL_ERROR); + _err("Failed to connect to the Percona web API: $EVAL_ERROR"); + } + + # ######################################################################## + # --send-data and exit. + # ######################################################################## + if ( my $service = $o->get('send-data') ) { + # TODO: rewrite Daemon to have args passed in so we can do + # a PID file check for spool procs. Or implement file locking. + send_data( + client => $client, + agent => $agent, + service => $service, + lib_dir => $->get('lib'), + spool_dir => $o->get('spool'), + ); + _info("Done sending data for the $service service, exit $exit_status"); + exit $exit_status; + } + + # ######################################################################## + # This is the main pt-agent daemon, a long-running and resilient + # process. Only internal errors should cause it to stop. Else, + # external errors, like Percona web API not responding, should be + # retried forever. + # ######################################################################## + # Check and init the config file. my $config_file = get_config_file(); _info("Config file: $config_file"); @@ -4560,12 +4549,10 @@ sub connect_to_percona { have_required_args(\%args, qw( api_key + lib_dir )) or die; - my $api_key = $args{api_key}; - my $interval = $args{interval}; - - # Optional args - my $agent_id = $args{agent_id}; + my $api_key = $args{api_key}; + my $lib_dir = $args{lib_dir}; # During initial connection and agent init, wait less time # than --check-interval between errors. @@ -4577,18 +4564,21 @@ sub connect_to_percona { sleep $init_interval; }; - # Get a connected Percona Web API client. - my $client = get_api_client( + # Connect to https://api.pws.percona.com and get entry links. + # Don't return until successful. + my ($client, $entry_links) = get_api_client( api_key => $api_key, tries => undef, interval => $init_wait, ); - # Start or create the agent. + # Create a new or update an existing Agent resource. + # Don't return until successful. my $agent = init_agent( - client => $client, - interval => $init_wait, - agent_id => $agent_id, # optional + client => $client, + interval => $init_wait, + lib_dir => $lib_dir, + agents_link => $entry_links->{agents}, ); return $client, $agent; @@ -4606,16 +4596,18 @@ sub get_api_client { my $interval = $args{interval}; # Optional args - my $tries = $args{tries}; - my $oktorun = $args{oktorun} || sub { return $oktorun }; + my $tries = $args{tries}; + my $_oktorun = $args{oktorun} || sub { return $oktorun }; - my $client; - while ( $oktorun->() && !$client && (!defined $tries || $tries--) ) { + my $client = Percona::WebAPI::Client->new( + api_key => $api_key, + ); + + my $entry_links; + while ( $_oktorun->() && !$entry_links && (!defined $tries || $tries--) ) { _info("Connecting to Percona Web Services"); eval { - $client = Percona::WebAPI::Client->new( - api_key => $api_key, - ); + $entry_links = $client->get(link => $client->entry_link); }; if ( $EVAL_ERROR ) { _warn($EVAL_ERROR); @@ -4626,7 +4618,7 @@ sub get_api_client { } } - return $client; + return $client, $entry_links; } # Initialize the agent, i.e. create and return an Agent resource. @@ -4638,14 +4630,17 @@ sub init_agent { have_required_args(\%args, qw( client interval + lib_dir + agents_link )) or die; - my $client = $args{client}; - my $interval = $args{interval}; + my $client = $args{client}; + my $interval = $args{interval}; + my $lib_dir = $args{lib_dir}; + my $agents_link = $args{agents_link}; # Optional args - my $agent_id = $args{agent_id}; my $versions = $args{versions}; - my $oktorun = $args{oktorun} || sub { return $oktorun }; + my $_oktorun = $args{oktorun} || sub { return $oktorun }; _info('Initializing agent'); @@ -4653,42 +4648,64 @@ sub init_agent { # have changed, this can affect how services are implemented. $versions ||= get_versions(); - # Make an Agent resource. If there's an agent_id, the existing Agent - # is updated (PUT); else, a new agent is created (POST). + # If there's a saved agent, then this is an existing agent being + # restarted. Else this is a new agent. + my $agent_file = $lib_dir . "/agent"; + my $agent; my $action; - if ( $agent_id ) { - $action = 'put'; + if ( -f $agent_file ) { + _info("Reading saved Agent from $agent_file"); + my $agent_hashref = decode_json(slurp($agent_file)); + $agent = Percona::WebAPI::Resource::Agent->new(%$agent_hashref); + $action = 'put'; # must be lc } else { - $action = 'post'; - $agent_id = get_uuid(); + _info("Creating new Agent"); + $action = 'post'; # must be lc + $agent = Percona::WebAPI::Resource::Agent->new( + id => 0, # PWS will change this + versions => $versions, + hostname => `hostname`, + ); } - my $agent = Percona::WebAPI::Resource::Agent->new( - id => $agent_id, - versions => $versions, - hostname => `hostname`, - ); - - while ( $oktorun->() ) { - _info($action eq 'put' ? "Updating agent $agent_id" - : "Creating new agent $agent_id"); + # Try forever to create/update the Agent. The tool can't + # do anything without an Agent, so we must succeed to proceed. + my $new_agent_link; # Location header in POST response + while ( $_oktorun->() ) { + _info($action eq 'put' ? "Updating agent " . $agent->id + : "Creating new agent"); eval { - $client->$action( - url => $client->links->{agents}, + $new_agent_link = $client->$action( + link => $agents_link, resources => $agent, ); }; + last unless $EVAL_ERROR; + _warn($EVAL_ERROR); + $interval->(); + } + + # If the Agent was new, POST will have returned a link to + # the newly created and updated Agent resource. + if ( $new_agent_link ) { + $agent = $client->get( + link => $new_agent_link, + ); + eval { + save_agent( + agent => $agent, + file => $agent_file, + ); + }; if ( $EVAL_ERROR ) { - _warn($EVAL_ERROR); - $interval->(); - } - else { - _info("Initialized"); - last; + _warn("Error saving Agent to $agent_file: $EVAL_ERROR\n" + . "pt-agent will continue running and try to save " + . "the Agent later."); } } + _info("Agent initialized and ready"); return $agent; } @@ -4726,9 +4743,9 @@ sub run_agent { eval { _info('Getting config'); - # Get the agent's config from Percona. + # Get the agent's Config from Percona. my $new_config = $client->get( - url => $client->links->{config}, + link => $agent->links->{config}, ); # If the current and new configs are different, @@ -4763,13 +4780,13 @@ sub run_agent { # Get services only if there's a current, running config. # Without one, we won't know how to implement services. - if ( $config ) { + if ( $config && $config->links->{services} ) { eval { _info('Getting services'); # Get services from Percona. my $new_services = $client->get( - url => $client->links->{services}, + link => $config->links->{services}, ); # If the current and new services are different, @@ -4780,6 +4797,7 @@ sub run_agent { write_services( services => $new_services, lib_dir => $lib_dir, + json => $args{json}, # optional, for testing ); schedule_services( @@ -4862,6 +4880,9 @@ sub write_services { my $services = $args{services}; my $lib_dir = $args{lib_dir}; + # Optional args + my $json = $args{json}; # for testing + $lib_dir .= '/services'; _info("Writing services to $lib_dir"); @@ -4873,7 +4894,7 @@ sub write_services { my $action = -f $file ? 'Updated' : 'Created'; open my $fh, '>', $file or die "Error opening $file: $OS_ERROR"; - print { $fh } as_json($service) + print { $fh } as_json($service, with_links => 1, json => $json) or die "Error writing to $file: $OS_ERROR"; close $fh or die "Error closing $file: $OS_ERROR"; @@ -4974,9 +4995,9 @@ sub make_new_crontab { return $new_crontab; } -# #################### # -# Service process subs # -# #################### # +# ########################## # +# --run-service process subs # +# ########################## # sub run_service { my (%args) = @_; @@ -5116,9 +5137,9 @@ sub replace_special_vars { return $new_cmd; } -# ################## # -# Spool process subs # -# ################## # +# ######################## # +# --send-data process subs # +# ######################## # # Send every file or directory in each service's directory in --spool/. # E.g. --spool/query-monitor should contain files with pt-query-digest @@ -5130,89 +5151,70 @@ sub send_data { client agent service + lib_dir spool_dir )) or die; my $client = $args{client}; my $agent = $args{agent}; my $service = $args{service}; + my $lib_dir = $args{lib_dir}; my $spool_dir = $args{spool_dir}; - # Iterate through the service dirs in --spool/. - chdir $spool_dir - or die "Error changing dir to $spool_dir: $OS_ERROR"; - opendir(my $spool_dh, $spool_dir) - or die "Error opening $spool_dir: $OS_ERROR"; - _info("Checking spool directory $spool_dir"); - SERVICE: - while ( my $service_dir = readdir($spool_dh) ) { - next unless -d $service_dir && $service_dir !~ m/^\./; + my $service_dir = $spool_dir . '/' . $service; + my $service_file = $lib_dir . '/services/' . $service; - # Need a link for the service to know where to send the data. - # TODO: should pt-agent rm the old service dir? - if ( !$client->links->{$service_dir} ) { - _warn("Ignoring $service_dir because there is no link for " - . "the service. If this agent no longer implements " - . "the service, then remove $spool_dir/$service_dir/."); - next SERVICE; - } + # Re-create the Service resource object from the saved service file. + # TODO: test + if ( !-f $service_file ) { + _err("Cannot send data for the $service service because " + . "$service_file does not exist."); + } + $service = decode_json(slurp($service_file)); + $service = Percona::WebAPI::Resource::Service->new(%$service); - # Iterate through the data files or dirs in this service's dir. - opendir(my $service_dh, $service_dir); - if ( !$service_dh ) { + # Iterate through service's spool dir and send the data file therein. + # TODO: if the service dir doesn't exist? + opendir(my $service_dh, $service_dir) + or die "Error opening $service_dir: $OS_ERROR"; + DATA_FILE: + while ( my $file = readdir($service_dh) ) { + $file = "$service_dir/$file"; + next unless -f $file; + + eval { + # Send the file as-is. The --run-service process should + # have written the data in a format that's ready to send. + send_file( + client => $client, + agent => $agent, + file => $file, + link => $service->links->{send_data}, + ); + }; + if ( $EVAL_ERROR ) { chomp $EVAL_ERROR; - _warn("Error opening $service_dir: $OS_ERROR"); - next SERVICE; + _warn("Failed to send $file: $EVAL_ERROR"); + next DATA_FILE; } - DATA: - while ( my $file = readdir($service_dh) ) { - next unless -f "$service_dir/$file"; - $file = "$service_dir/$file"; - # Send the data to Percona. - eval { - if ( -d $file ) { - # TODO - } - else { - # The file is a file, yay. Just send it as-is. - send_file( - client => $client, - agent => $agent, - file => $file, - url => $client->links->{$service_dir}, - ); - # TODO: url should really be Service->links->self. - } - }; - if ( $EVAL_ERROR ) { - chomp $EVAL_ERROR; - _warn("Failed to send $file: $EVAL_ERROR"); - next DATA; - } + # Data file sent successfully; now remove it. Failure here + # is an error, not a warning, because if we can't remove the + # file then we risk re-sending it, and currently we have no + # way to determine if a file has been sent or not other than + # whether it exists or not. + eval { + unlink $file or die $OS_ERROR; + }; + if ( $EVAL_ERROR ) { + chomp $EVAL_ERROR; + _warn("Sent $file but failed to remove it: $EVAL_ERROR"); + last DATA_FILE; + } - # Remove the data if sent successfully. - eval { - if ( -d $file ) { - # TODO: rmtree - } - else { - unlink $file or die $OS_ERROR; - } - }; - if ( $EVAL_ERROR ) { - chomp $EVAL_ERROR; - _warn("Sent $file but failed to remove it: $EVAL_ERROR"); - last SERVICE; - } - - _info("Sent and removed $file"); - } # DATA - closedir $service_dh - or warn "Error closing $service_dir: $OS_ERROR"; - } # SERVICE - - closedir $spool_dh - or warn "Error closeing $spool_dir: $OS_ERROR"; + _info("Sent and removed $file"); + } + closedir $service_dh + or warn "Error closing $service_dir: $OS_ERROR"; return; } @@ -5225,14 +5227,15 @@ sub send_file { client agent file - url + link )) or die; my $client = $args{client}; my $agent = $args{agent}; my $file = $args{file}; - my $url = $args{url}; + my $link = $args{link}; - _info("Sending $file to $url"); + my $file_size = -s $file; + _info("Sending $file ($file_size bytes) to $link"); # Create a multi-part resource: first the Agent, so Percona knows # from whom this data is coming, then the contents of the file as-is. @@ -5249,7 +5252,7 @@ CONTENT chomp($resource); # remove trailing newline $client->post( - url => $url, + link => $link, resources => $resource, ); @@ -5284,6 +5287,24 @@ sub init_config_file { return; } +sub save_agent { + my (%args) = @_; + have_required_args(\%args, qw( + agent + file + )) or die; + my $agent = $args{agent}; + my $file = $args{file}; + _info("Saving Agent to $file"); + open my $fh, '>', $file + or die "Error opening $file: $OS_ERROR"; + print { $fh } as_json($agent) + or die "Error writing to $file: $OS_ERROR"; + close $fh + or die "Error closing $file: $OS_ERROR"; + return; +} + sub slurp { my ($file) = @_; return unless -f $file; @@ -5321,10 +5342,6 @@ sub _err { exit $exit_status; } -sub get_uuid { - return '123'; -} - # TODO: use VersionCheck::get_versions(). sub get_versions { return { @@ -5400,12 +5417,6 @@ L<"--run-service"> and L<"--send-data"> are mutually exclusive. =over -=item --agent-id - -type: string - -The agent's unique ID. - =item --api-key type: string diff --git a/lib/Percona/Test/Mock/UserAgent.pm b/lib/Percona/Test/Mock/UserAgent.pm index 3f85b36e..cdfefcd4 100644 --- a/lib/Percona/Test/Mock/UserAgent.pm +++ b/lib/Percona/Test/Mock/UserAgent.pm @@ -20,8 +20,6 @@ { package Percona::Test::Mock::UserAgent; -use Percona::Toolkit qw(Dumper); - sub new { my ($class, %args) = @_; my $self = { diff --git a/lib/Percona/WebAPI/Client.pm b/lib/Percona/WebAPI/Client.pm index ebf361c4..6c4a9491 100644 --- a/lib/Percona/WebAPI/Client.pm +++ b/lib/Percona/WebAPI/Client.pm @@ -295,7 +295,7 @@ sub _request { if ( !($response->code >= 200 && $response->code < 400) ) { die Percona::WebAPI::Exception::Request->new( method => $method, - link => $link, + url => $link, content => $content, status => $response->code, error => "Failed to $method $link", diff --git a/lib/Percona/WebAPI/Representation.pm b/lib/Percona/WebAPI/Representation.pm index 369a8d56..75ea6b7c 100644 --- a/lib/Percona/WebAPI/Representation.pm +++ b/lib/Percona/WebAPI/Representation.pm @@ -47,14 +47,14 @@ sub as_hashref { } sub as_json { - my $resource = shift; + my ($resource, %args) = @_; - my $json = JSON->new; + my $json = $args{json} || JSON->new; $json->allow_blessed([]); $json->convert_blessed([]); return $json->encode( - ref $resource eq 'ARRAY' ? $resource : as_hashref($resource) + ref $resource eq 'ARRAY' ? $resource : as_hashref($resource, %args) ); } diff --git a/t/pt-agent/init_agent.t b/t/pt-agent/init_agent.t index 7f86525d..734e07b8 100644 --- a/t/pt-agent/init_agent.t +++ b/t/pt-agent/init_agent.t @@ -11,6 +11,7 @@ use warnings FATAL => 'all'; use English qw(-no_match_vars); use Test::More; use JSON; +use File::Temp qw(tempdir); use Percona::Test; use Percona::Test::Mock::UserAgent; @@ -19,26 +20,19 @@ require "$trunk/bin/pt-agent"; Percona::Toolkit->import(qw(Dumper)); Percona::WebAPI::Representation->import(qw(as_hashref)); +my $tmpdir = tempdir("/tmp/pt-agent.$PID.XXXXXX", CLEANUP => 1); + my $ua = Percona::Test::Mock::UserAgent->new( encode => sub { my $c = shift; return encode_json($c || {}) }, ); -# When Percona::WebAPI::Client is created, it gets its base_url, -# to get the API's entry links. -$ua->{responses}->{get} = [ - { - content => { - agents => '/agents', - }, - }, -]; - my $client = eval { Percona::WebAPI::Client->new( api_key => '123', ua => $ua, ); }; + is( $EVAL_ERROR, '', @@ -49,17 +43,29 @@ is( # Init a new agent, i.e. create it. # ############################################################################# -# Since we're passing agent_id, the tool will call its get_uuid() -# and POST an Agent resource to the fake ^ agents links. It then -# expects config and services links. +my $return_agent = { + id => '123', + hostname => `hostname`, + versions => { + 'Percona::WebAPI::Client' => "$Percona::WebAPI::Client::VERSION", + 'Perl' => sprintf('%vd', $PERL_VERSION), + }, + links => { + self => '/agents/123', + config => '/agents/123/config', + }, +}; $ua->{responses}->{post} = [ { - content => { - agents => '/agents', - config => '/agents/123/config', - services => '/agents/123/services', - }, + headers => { 'Location' => '/agents/123' }, + }, +]; + +$ua->{responses}->{get} = [ + { + headers => { 'X-Percona-Resource-Type' => 'Agent' }, + content => $return_agent, }, ]; @@ -76,84 +82,92 @@ my $agent; my $output = output( sub { $agent = pt_agent::init_agent( - client => $client, - interval => $interval, + client => $client, + interval => $interval, + agents_link => "/agents", + lib_dir => $tmpdir, ); }, stderr => 1, ); is_deeply( - as_hashref($agent), - { - id => '123', - hostname => `hostname`, - versions => { - 'Percona::WebAPI::Client' => "$Percona::WebAPI::Client::VERSION", - 'Perl' => sprintf('%vd', $PERL_VERSION), - } - }, + as_hashref($agent, with_links => 1), + $return_agent, 'Create new Agent' -) or diag(Dumper(as_hashref($agent))); +) or diag($output, Dumper(as_hashref($agent, with_links => 1))); is( scalar @wait, 0, "Client did not wait (new Agent)" -); +) or diag($output); -is_deeply( - $client->links, - { - agents => '/agents', - config => '/agents/123/config', - services => '/agents/123/services', - }, - "Client got new links" -) or diag(Dumper($client->links)); +# The tool should immediately write the Agent to --lib/agent. +ok( + -f "$tmpdir/agent", + "Wrote Agent to --lib/agent" +) or diag($output); + +# From above, we return an Agent with id=123. Check that this +# is what the tool actually wrote. +$output = `cat $tmpdir/agent 2>/dev/null`; +like( + $output, + qr/"id":"123"/, + "Saved new Agent" +) or diag($output); # Repeat this test but this time fake an error, so the tool isn't # able to create the Agent first time, so it should wait (call # interval), and try again. +unlink "$tmpdir/agent" if -f "$tmpdir/agent"; + +$return_agent->{id} = '456'; +$return_agent->{links} = { + self => '/agents/456', + config => '/agents/456/config', +}; + $ua->{responses}->{post} = [ { # 1, the fake error code => 500, }, # 2, code should call interval { # 3, code should try again, then receive this - content => { - agents => '/agents', - config => '/agents/456/config', - services => '/agents/456/services', - }, + code => 200, + headers => { 'Location' => '/agents/456' }, + }, +]; + # 4, code will GET the new Agent +$ua->{responses}->{get} = [ + { + headers => { 'X-Percona-Resource-Type' => 'Agent' }, + content => $return_agent, }, ]; @wait = (); +$ua->{requests} = []; $output = output( sub { $agent = pt_agent::init_agent( - client => $client, - interval => $interval, + client => $client, + interval => $interval, + agents_link => '/agents', + lib_dir => $tmpdir, ); }, stderr => 1, ); is_deeply( - as_hashref($agent), - { - id => '123', - hostname => `hostname`, - versions => { - 'Percona::WebAPI::Client' => "$Percona::WebAPI::Client::VERSION", - 'Perl' => sprintf '%vd', $PERL_VERSION, - } - }, + as_hashref($agent, with_links => 1), + $return_agent, 'Create new Agent after error' -) or diag(Dumper(as_hashref($agent))); +) or diag(Dumper(as_hashref($agent, with_links => 1))); is( scalar @wait, @@ -161,38 +175,63 @@ is( "Client waited" ); +is_deeply( + $ua->{requests}, + [ + 'POST /agents', # first attempt, 500 error + 'POST /agents', # second attemp, 200 OK + 'GET /agents/456', # GET new Agent + ], + "POST POST GET new Agent" +) or diag(Dumper($ua->{requests})); + like( $output, qr{WARNING Failed to POST /agents}, "POST /agents failure logged" ); +ok( + -f "$tmpdir/agent", + "Wrote Agent to --lib/agent again" +); + +$output = `cat $tmpdir/agent 2>/dev/null`; +like( + $output, + qr/"id":"456"/, + "Saved new Agent again" +) or diag($output); + +# Do not remove lib/agent; the next test will use it. + # ############################################################################# # Init an existing agent, i.e. update it. # ############################################################################# -# When agent_id is passed to init_agent(), the tool does PUT Agent -# to tell Percona that the Agent has come online again, and to update -# the agent's versions. +# If --lib/agent exists, the tool should create an Agent obj from it +# then attempt to PUT it to the agents link. The previous tests should +# have left an Agent file with id=456. + +my $hashref = decode_json(pt_agent::slurp("$tmpdir/agent")); +my $saved_agent = Percona::WebAPI::Resource::Agent->new(%$hashref); $ua->{responses}->{put} = [ { - content => { - agents => '/agents', - config => '/agents/999/config', - services => '/agents/999/services', - }, + code => 200, }, ]; @wait = (); +$ua->{requests} = []; $output = output( sub { $agent = pt_agent::init_agent( - client => $client, - interval => $interval, - agent_id => '999', + client => $client, + interval => $interval, + agents_link => '/agents', + lib_dir => $tmpdir, ); }, stderr => 1, @@ -200,23 +239,30 @@ $output = output( is_deeply( as_hashref($agent), - { - id => '999', - hostname => `hostname`, - versions => { - 'Percona::WebAPI::Client' => "$Percona::WebAPI::Client::VERSION", - 'Perl' => sprintf '%vd', $PERL_VERSION, - } - }, - 'Update old Agent' -) or diag(Dumper(as_hashref($agent))); + as_hashref($saved_agent), + 'Used saved Agent' +) or diag($output, Dumper(as_hashref($agent))); + +like( + $output, + qr/Reading saved Agent from $tmpdir\/agent/, + "Reports reading saved Agent" +) or diag($output); is( scalar @wait, 0, - "Client did not wait (old Agent)" + "Client did not wait (saved Agent)" ); +is_deeply( + $ua->{requests}, + [ + 'PUT /agents', + ], + "PUT saved Agent" +) or diag(Dumper($ua->{requests})); + # ############################################################################# # Done. # ############################################################################# diff --git a/t/pt-agent/run_agent.t b/t/pt-agent/run_agent.t index 8bab3b98..74a65849 100644 --- a/t/pt-agent/run_agent.t +++ b/t/pt-agent/run_agent.t @@ -33,10 +33,11 @@ if ( $crontab ) { # Create mock client and Agent # ############################################################################# -# These aren't the real tests yet: to run_agent(), first we need +# These aren't the real tests yet: to run_agent, first we need # a client and Agent, so create mock ones. -my $json = JSON->new; +my $output; +my $json = JSON->new->canonical([1])->pretty; $json->allow_blessed([]); $json->convert_blessed([]); @@ -44,40 +45,28 @@ my $ua = Percona::Test::Mock::UserAgent->new( encode => sub { my $c = shift; return $json->encode($c || {}) }, ); -# Create cilent, get entry links -$ua->{responses}->{get} = [ - { - content => { - agents => '/agents', - }, - }, -]; - -my $links = { - agents => '/agents', - config => '/agents/1/config', - services => '/agents/1/services', -}; - -# Init agent, put Agent resource, return more links -$ua->{responses}->{put} = [ - { - content => $links, - }, -]; - my $client = eval { Percona::WebAPI::Client->new( api_key => '123', ua => $ua, ); }; + is( $EVAL_ERROR, '', 'Create mock client' ) or die; +my $agent = Percona::WebAPI::Resource::Agent->new( + id => '123', + hostname => 'host', + links => { + self => '/agents/123', + config => '/agents/123/config', + }, +); + my @wait; my $interval = sub { my $t = shift; @@ -85,41 +74,8 @@ my $interval = sub { print "interval=" . (defined $t ? $t : 'undef') . "\n"; }; -my $agent; -my $output = output( - sub { - $agent = pt_agent::init_agent( - client => $client, - interval => $interval, - agent_id => 1, - ); - }, - stderr => 1, -); - -my $have_agent = 1; - -is_deeply( - as_hashref($agent), - { - id => '1', - hostname => `hostname`, - versions => { - 'Percona::WebAPI::Client' => "$Percona::WebAPI::Client::VERSION", - 'Perl' => sprintf '%vd', $PERL_VERSION, - } - }, - 'Create mock Agent' -) or $have_agent = 0; - -# Can't run_agent() without and agent. -if ( !$have_agent ) { - diag(Dumper(as_hashref($agent))); - die; -} - # ############################################################################# -# Test run_agent() +# Test run_agent # ############################################################################# # The agent does just basically 2 things: check for new config, and @@ -130,9 +86,15 @@ if ( !$have_agent ) { # same config. my $config = Percona::WebAPI::Resource::Config->new( + id => '1', + name => 'Default', options => { 'check-interval' => "60", }, + links => { + self => '/agents/123/config', + services => '/agents/123/services', + }, ); my $run0 = Percona::WebAPI::Resource::Run->new( @@ -147,16 +109,19 @@ my $svc0 = Percona::WebAPI::Resource::Service->new( run_schedule => '1 * * * *', spool_schedule => '2 * * * *', runs => [ $run0 ], + links => { + send_data => '/query-monitor', + }, ); $ua->{responses}->{get} = [ { headers => { 'X-Percona-Resource-Type' => 'Config' }, - content => as_hashref($config), + content => as_hashref($config, with_links => 1), }, { headers => { 'X-Percona-Resource-Type' => 'Service' }, - content => [ as_hashref($svc0) ], + content => [ as_hashref($svc0, with_links => 1) ], }, ]; @@ -198,6 +163,7 @@ $output = output( config_file => $config_file, lib_dir => $tmpdir, oktorun => $oktorun, # optional, for testing + json => $json, # optional, for testing ); }, stderr => 1, @@ -224,7 +190,7 @@ is( ok( -f "$tmpdir/services/query-monitor", "Created services/query-monitor" -); +) or diag($output); chomp(my $n_files = `ls -1 $tmpdir/services| wc -l | awk '{print \$1}'`); is( @@ -255,7 +221,7 @@ like( ); # ############################################################################# -# Run run_agent() again, like the agent had been stopped and restarted. +# Run run_agent again, like the agent had been stopped and restarted. # ############################################################################# $ua->{responses}->{get} = [ @@ -311,6 +277,7 @@ $output = output( config_file => $config_file, lib_dir => $tmpdir, oktorun => $oktorun, # optional, for testing + json => $json, # optional, for testing ); }, stderr => 1, diff --git a/t/pt-agent/samples/service001 b/t/pt-agent/samples/service001 index 09a96d6f..926e2202 100644 --- a/t/pt-agent/samples/service001 +++ b/t/pt-agent/samples/service001 @@ -1 +1,16 @@ -{"spool_schedule":"2 * * * *","runs":[{"number":"0","options":"--output json","output":"spool","program":"pt-query-digest"}],"run_schedule":"1 * * * *","name":"query-monitor"} \ No newline at end of file +{ + "links" : { + "send_data" : "/query-monitor" + }, + "name" : "query-monitor", + "run_schedule" : "1 * * * *", + "runs" : [ + { + "number" : "0", + "options" : "--output json", + "output" : "spool", + "program" : "pt-query-digest" + } + ], + "spool_schedule" : "2 * * * *" +} diff --git a/t/pt-agent/samples/write_services001 b/t/pt-agent/samples/write_services001 new file mode 100644 index 00000000..e6c62c08 --- /dev/null +++ b/t/pt-agent/samples/write_services001 @@ -0,0 +1,16 @@ +{ + "links" : { + "send_data" : "/query-monitor" + }, + "name" : "query-monitor", + "run_schedule" : "1 * * * *", + "runs" : [ + { + "number" : "0", + "options" : "--report-format profile /Users/daniel/p/pt-agent/t/lib/samples/slowlogs/slow008.txt", + "output" : "spool", + "program" : "/Users/daniel/p/pt-agent/bin/pt-query-digest" + } + ], + "spool_schedule" : "2 * * * *" +} diff --git a/t/pt-agent/send_data.t b/t/pt-agent/send_data.t index 9aad375f..c073dc18 100644 --- a/t/pt-agent/send_data.t +++ b/t/pt-agent/send_data.t @@ -84,7 +84,11 @@ is_deeply( my $tmpdir = tempdir("/tmp/pt-agent.$PID.XXXXXX", CLEANUP => 1); mkdir "$tmpdir/query-monitor" or die "Cannot mkdir $tmpdir/query-monitor: $OS_ERROR"; -`cp $trunk/$sample/query-monitor/data001 $tmpdir/query-monitor`; +mkdir "$tmpdir/services" + or die "Cannot mkdir $tmpdir/services: $OS_ERROR"; + +`cp $trunk/$sample/query-monitor/data001 $tmpdir/query-monitor/`; +`cp $trunk/$sample/service001 $tmpdir/services/query-monitor`; $ua->{responses}->{post} = [ { @@ -97,8 +101,9 @@ my $output = output( pt_agent::send_data( client => $client, agent => $agent, - spool_dir => $tmpdir, service => 'query-monitor', + lib_dir => $tmpdir, + spool_dir => $tmpdir, ), }, stderr => 1, @@ -108,7 +113,15 @@ is( scalar @{$client->ua->{content}->{post}}, 1, "Only sent 1 resource" -) or diag(Dumper($client->ua->{content}->{post})); +) or diag($output, Dumper($client->ua->{content}->{post})); + +is_deeply( + $ua->{requests}, + [ + 'POST /query-monitor', + ], + "POST to Service.links.send_data" +); ok( no_diff( @@ -127,13 +140,4 @@ ok( # ############################################################################# # Done. # ############################################################################# - -# pt_agent::send_data() does chdir and since it and this test -# are the same process, it has chdir'ed us into the temp dir -# that Perl is going to auto-remove, so we need to chdir back -# else we'll get this error: "cannot remove path when cwd is -# /tmp/pt-agent.16588.d1bFVw for /tmp/pt-agent.16588.d1bFVw: -# at /usr/share/perl5/File/Temp.pm line 902" -chdir($ENV{PWD} || $trunk); - done_testing; diff --git a/t/pt-agent/write_services.t b/t/pt-agent/write_services.t new file mode 100644 index 00000000..f993331a --- /dev/null +++ b/t/pt-agent/write_services.t @@ -0,0 +1,91 @@ +#!/usr/bin/env perl + +BEGIN { + die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n" + unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH}; + unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; +}; + +use strict; +use warnings FATAL => 'all'; +use English qw(-no_match_vars); +use Test::More; +use JSON; +use File::Temp qw(tempdir); + +use Percona::Test; +use Percona::Test::Mock::UserAgent; +require "$trunk/bin/pt-agent"; + +Percona::Toolkit->import(qw(Dumper have_required_args)); +Percona::WebAPI::Representation->import(qw(as_hashref)); + +my $json = JSON->new->canonical([1])->pretty; +my $sample = "t/pt-agent/samples"; +my $tmpdir = tempdir("/tmp/pt-agent.$PID.XXXXXX", CLEANUP => 1); + +mkdir "$tmpdir/services" or die "Error mkdir $tmpdir/services: $OS_ERROR"; + +sub test_write_services { + my (%args) = @_; + have_required_args(\%args, qw( + services + file + )) or die; + my $services = $args{services}; + my $file = $args{file}; + + die "$trunk/$sample/$file does not exist" + unless -f "$trunk/$sample/$file"; + + my $output = output( + sub { + pt_agent::write_services( + services => $services, + lib_dir => $tmpdir, + json => $json, + ); + }, + stderr => 1, + ); + + foreach my $service ( @$services ) { + my $name = $service->name; + ok( + no_diff( + "cat $tmpdir/services/$name 2>/dev/null", + "$sample/$file", + ), + "$file $name" + ) or diag($output, `cat $tmpdir/services/$name`); + } + + diag(`rm -rf $tmpdir/*`); +} + +my $run0 = Percona::WebAPI::Resource::Run->new( + number => '0', + program => "$trunk/bin/pt-query-digest", + options => "--report-format profile $trunk/t/lib/samples/slowlogs/slow008.txt", + output => 'spool', +); + +my $svc0 = Percona::WebAPI::Resource::Service->new( + name => 'query-monitor', + run_schedule => '1 * * * *', + spool_schedule => '2 * * * *', + runs => [ $run0 ], + links => { send_data => '/query-monitor' }, +); + +# Key thing here is that the links are written because +# --send-data requires them. +test_write_services( + services => [ $svc0 ], + file => "write_services001", +); + +# ############################################################################# +# Done. +# ############################################################################# +done_testing;