sub _escape_argument
{
- local $_ = shift;
+ my $arg = shift;
- return $_ if /^\w+$/;
+ return $arg if $arg =~ /^\w+$/;
- s#\\#\\\\#g;
- s#"#\\"#g;
- return "\"$_\"";
+ $arg =~ s#\\#\\\\#g;
+ $arg =~ s#"#\\"#g;
+ return "\"$arg\"";
+}
+
+# Send a command on a socket, including any required argument escaping.
+# Return a single line of result.
+sub _socket_command {
+ my ($self, $command, $args) = @_;
+
+ my $fh = $self->{sock} or confess ('object has no filehandle');
+
+ if($args) {
+ my $identifier = _create_identifier ($args) or return;
+ $command .= ' ' . _escape_argument ($identifier) . "\n";
+ } else {
+ $command .= "\n";
+ }
+ _debug "-> $command";
+ $fh->print($command);
+
+ my $response = $fh->getline;
+ chomp $response;
+ _debug "<- $response\n";
+ return $response;
+}
+
+# Read any remaining results from a socket and pass them to
+# a callback for caller-defined mangling.
+sub _socket_chat
+{
+ my ($self, $msg, $callback, $cbdata) = @_;
+ my ($nresults, $ret);
+ my $fh = $self->{sock} or confess ('object has no filehandle');
+
+ ($nresults, $msg) = split / /, $msg, 2;
+ if ($nresults <= 0)
+ {
+ $self->{error} = $msg;
+ return;
+ }
+
+ for (1 .. $nresults)
+ {
+ my $entry = $fh->getline;
+ chomp $entry;
+ _debug "<- $entry\n";
+ $callback->($entry, $cbdata);
+ }
+ return $cbdata;
+}
+
+# Send a raw message on a socket.
+# Returns true upon success and false otherwise.
+sub _send_message
+{
+ my ($self, $msg) = @_;
+
+ my $fh = $self->{'sock'} or confess ('object has no filehandle');
+
+ $msg .= "\n" unless $msg =~/\n$/;
+
+ #1024 is default buffer size at unixsock.c us_handle_client()
+ warn "Collectd::Unixsock->_send_message(\$msg): message is too long!" if length($msg) > 1024;
+
+ _debug "-> $msg";
+ $fh->print($msg);
+
+ $msg = <$fh>;
+ chomp ($msg);
+ _debug "<- $msg\n";
+
+ my ($status, $error) = split / /, $msg, 2;
+ return 1 if $status == 0;
+
+ $self->{error} = $error;
+ return;
}
=head1 PUBLIC METHODS
{
my $self = shift;
my %args = @_;
-
- my ($status, $msg, $identifier, $ret);
- my $fh = $self->{sock} or confess ('object has no filehandle');
-
- $ret = {};
-
- $identifier = _create_identifier (\%args) or return;
-
- $msg = 'GETVAL ' . _escape_argument ($identifier) . "\n";
- _debug "-> $msg";
- print $fh $msg;
-
- $msg = <$fh>;
- chomp ($msg);
- _debug "<- $msg\n";
-
- ($status, $msg) = split / /, $msg, 2;
- if ($status <= 0)
- {
- $self->{error} = $msg;
- return;
- }
-
- for (1 .. $status)
- {
- my $entry = <$fh>;
- chomp $entry;
- _debug "<- $entry\n";
-
- if ($entry =~ m/^(\w+)=NaN$/)
- {
- $ret->{$1} = undef;
- }
- elsif ($entry =~ m/^(\w+)=(.*)$/ and looks_like_number($2))
- {
- $ret->{$1} = 0.0 + $2;
- }
- }
-
+ my $ret = {};
+
+ my $msg = $self->_socket_command('GETVAL', \%args) or return;
+ $self->_socket_chat($msg, sub {
+ local $_ = shift;
+ my $ret = shift;
+ /^(\w+)=NaN$/ and $ret->{$1} = undef, return;
+ /^(\w+)=(.*)$/ and looks_like_number($2) and $ret->{$1} = 0 + $2, return;
+ }, $ret
+ );
return $ret;
} # }}} sub getval
{
my $self = shift;
my %args = @_;
-
- my ($status, $msg, $identifier, $ret);
- my $fh = $self->{sock} or confess ('object has no filehandle');
-
- $ret = {};
-
- $identifier = _create_identifier (\%args) or return;
-
- $msg = 'GETTHRESHOLD ' . _escape_argument ($identifier) . "\n";
- _debug "-> $msg";
- print $fh $msg;
-
- $msg = <$fh>;
- chomp ($msg);
- _debug "<- $msg\n";
-
- ($status, $msg) = split (' ', $msg, 2);
- if ($status <= 0)
- {
- $self->{error} = $msg;
- return;
- }
-
- for (1 .. $status)
- {
- my $entry = <$fh>;
- chomp ($entry);
- _debug "<- $entry\n";
-
- if ($entry =~ m/^([^:]+):\s*(\S.*)$/)
- {
- my $key = $1;
- my $value = $2;
-
- $key =~ s/(?:^\s+|\s$)//;
- $ret->{$key} = $value;
- }
- }
-
+ my $ret = {};
+
+ my $msg = $self->_socket_command('GETTHRESHOLD', \%args) or return;
+ $self->_socket_chat($msg, sub {
+ local $_ = shift;
+ my $ret = shift;
+ my ( $key, $val );
+ ( $key, $val ) = /^\s*([^:]+):\s*(.*)/ and do {
+ $key =~ s/\s*$//;
+ $ret->{$key} = $val;
+ };
+ }, $ret
+ );
return $ret;
} # }}} sub getthreshold
my $fh = $self->{sock} or confess;
my $interval = defined $args{interval} ?
- ' interval=' . _escape_argument ($args{interval}) : '';
+ ' interval=' . _escape_argument ($args{interval}) : '';
$identifier = _create_identifier (\%args) or return;
if (!$args{values})
. _escape_argument ($identifier)
. $interval
. ' ' . _escape_argument ($values) . "\n";
- _debug "-> $msg";
- print $fh $msg;
- $msg = <$fh>;
- chomp $msg;
- _debug "<- $msg\n";
+ return $self->_send_message($msg);
+} # putval
- ($status, $msg) = split / /, $msg, 2;
- return 1 if $status == 0;
+=item I<$res> = I<$self>-E<gt>B<listval_filter> ( C<%identifier> )
- $self->{error} = $msg;
- return;
-} # putval
+Queries a list of values from the daemon while restricting the results to
+certain hosts, plugins etc. The argument may be anything that passes for an
+identifier (cf. L<VALUE IDENTIFIERS>), although all fields are optional.
+The returned data is in the same format as from C<listval>.
+
+=cut
+
+sub listval_filter
+{
+ my $self = shift;
+ my %args = @_;
+ my @ret;
+ my $nresults;
+ my $fh = $self->{sock} or confess;
+
+ my $pattern =
+ (exists $args{host} ? "$args{host}" : '[^/]+') .
+ (exists $args{plugin} ? "/$args{plugin}" : '/[^/-]+') .
+ (exists $args{plugin_instance} ? "-$args{plugin_instance}" : '(?:-[^/]+)?') .
+ (exists $args{type} ? "/$args{type}" : '/[^/-]+') .
+ (exists $args{type_instance} ? "-$args{type_instance}" : '(?:-[^/]+)?');
+ $pattern = qr/^\d+(?:\.\d+)? $pattern$/;
+
+ my $msg = $self->_socket_command('LISTVAL') or return;
+ ($nresults, $msg) = split / /, $msg, 2;
+
+ # This could use _socket_chat() but doesn't for speed reasons
+ if ($nresults < 0)
+ {
+ $self->{error} = $msg;
+ return;
+ }
+
+ for (1 .. $nresults)
+ {
+ $msg = <$fh>;
+ chomp $msg;
+ _debug "<- $msg\n";
+ next unless $msg =~ $pattern;
+ my ($time, $ident) = split / /, $msg, 2;
+
+ $ident = _parse_identifier ($ident);
+ $ident->{time} = 0+$time;
+
+ push (@ret, $ident);
+ } # for (i = 0 .. $nresults)
+
+ return @ret;
+} # listval_filter
=item I<$res> = I<$self>-E<gt>B<listval> ()
sub listval
{
my $self = shift;
- my ($msg, $status);
+ my $nresults;
my @ret;
my $fh = $self->{sock} or confess;
- _debug "LISTVAL\n";
- print $fh "LISTVAL\n";
+ my $msg = $self->_socket_command('LISTVAL') or return;
+ ($nresults, $msg) = split / /, $msg, 2;
- $msg = <$fh>;
- chomp ($msg);
- _debug "<- $msg\n";
- ($status, $msg) = split / /, $msg, 2;
- if ($status < 0)
+ # This could use _socket_chat() but doesn't for speed reasons
+ if ($nresults < 0)
{
$self->{error} = $msg;
return;
}
- for (1 .. $status)
+ for (1 .. $nresults)
{
- my $time;
- my $ident;
-
$msg = <$fh>;
- chomp ($msg);
+ chomp $msg;
_debug "<- $msg\n";
- ($time, $ident) = split / /, $msg, 2;
+ my ($time, $ident) = split / /, $msg, 2;
$ident = _parse_identifier ($ident);
- $ident->{time} = int $time;
+ $ident->{time} = 0+$time;
push (@ret, $ident);
- } # for (i = 0 .. $status)
+ } # for (i = 0 .. $nresults)
return @ret;
} # listval
my $msg; # message sent to the socket
- for my $arg (qw( message severity ))
- {
- cluck ("Need argument `$arg'"), return unless $args{$arg};
- }
+ for my $arg (qw( message severity ))
+ {
+ cluck ("Need argument `$arg'"), return unless $args{$arg};
+ }
$args{severity} = lc $args{severity};
if (($args{severity} ne 'failure')
&& ($args{severity} ne 'warning')
. join (' ', map { $_ . '=' . _escape_argument ($args{$_}) } keys %args)
. "\n";
- _debug "-> $msg";
- print $fh $msg;
-
- $msg = <$fh>;
- chomp $msg;
- _debug "<- $msg\n";
-
- ($status, $msg) = split / /, $msg, 2;
- return 1 if $status == 0;
-
- $self->{error} = $msg;
- return;
+ return $self->_send_message($msg);
} # putnotif
=item I<$self>-E<gt>B<flush> (B<timeout> =E<gt> I<$timeout>, B<plugins> =E<gt> [...], B<identifier> =E<gt> [...]);
my $fh = $self->{sock} or confess;
- my $status = 0;
- my $msg = "FLUSH";
+ my $msg = "FLUSH";
- $msg .= " timeout=$args{timeout}" if defined $args{timeout};
+ $msg .= " timeout=$args{timeout}" if defined $args{timeout};
if ($args{plugins})
{
if ($args{identifier})
{
+ my $pre = $msg;
for my $identifier (@{$args{identifier}})
{
my $ident_str;
}
$ident_str = _create_identifier ($identifier) or return;
- $msg .= ' identifier=' . _escape_argument ($ident_str);
- }
- }
-
- $msg .= "\n";
-
- _debug "-> $msg";
- print $fh $msg;
+ $ident_str = ' identifier=' . _escape_argument ($ident_str);
- $msg = <$fh>;
- chomp ($msg);
- _debug "<- $msg\n";
+ if (length($msg)+length($ident_str) >= 1023) { #1024 - 1 byte for \n
+ $self->_send_message($msg) or return;
+ $msg = $pre;
+ }
- ($status, $msg) = split / /, $msg, 2;
- return 1 if $status == 0;
+ $msg .= $ident_str;
+ }
+ }
- $self->{error} = $msg;
- return;
+ return $self->_send_message($msg);
}
sub error
=cut
1;
-# vim: set fdm=marker :
+# vim: set fdm=marker noexpandtab: