diff options
Diffstat (limited to 'src/perl')
52 files changed, 4498 insertions, 0 deletions
diff --git a/src/perl/GNUmakefile b/src/perl/GNUmakefile new file mode 100644 index 0000000..f97ee88 --- /dev/null +++ b/src/perl/GNUmakefile @@ -0,0 +1,49 @@ +# +# Copyright (c) 2008-2009 Aconex. All Rights Reserved. +# +# This program is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation; either version 2 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# + +TOPDIR = ../.. +include $(TOPDIR)/src/include/builddefs + +SUBDIRS = PMDA LogSummary MMV LogImport + +default: $(SUBDIRS) + $(SUBDIRS_MAKERULE) + +install: $(SUBDIRS) + $(SUBDIRS_MAKERULE) +ifeq "$(shell [ '$(PACKAGE_DISTRIBUTION)' = cocoa \ + -o '$(PACKAGE_DISTRIBUTION)' = macosx \ + -o '$(PACKAGE_DISTRIBUTION)' = gentoo \ + -o '$(PACKAGE_DISTRIBUTION)' = solaris \ + ] && echo 1)" "1" + # Gather installed Perl files before packaging + if [ -n "$(DIST_MANIFEST)" ]; then \ + if [ "`echo $(TOPDIR)/perl-pcp-*.list`" != "$(TOPDIR)/perl-pcp-*.list" ]; then \ + cat $(TOPDIR)/perl-pcp-*.list | while read f; do \ + bn=`basename $$f .gz`; \ + dn=`dirname $$f`; \ + $(INSTALL) -d $$dn || exit 1; \ + src=`find */blib -name $$bn`; \ + if [ -x $$src ] ; then mode=0755; else mode=0644; fi; \ + $(INSTALL) -m $$mode $$src $$dn/$$bn || exit 1; \ + done; \ + fi; \ + fi +endif + +include $(BUILDRULES) + +default_pcp : default + +install_pcp : install diff --git a/src/perl/LogImport/Changes b/src/perl/LogImport/Changes new file mode 100644 index 0000000..db6f621 --- /dev/null +++ b/src/perl/LogImport/Changes @@ -0,0 +1,13 @@ +Revision history for Perl extension PCP::LogImport + +1.02 Thu May 23 15:30:53 EST 2013 + - add pmiBatch{PutValue,Write,End} extensions + - additional API error codes (badname,badtime) + +1.01 Sun Sep 23 12:34:53 EST 2012 + - add in definitions of the API error codes + - add in helper routines (pmiID + pmiInDom) + +1.00 Tue Jul 13 16:41:17 EST 2010 + - initial version + diff --git a/src/perl/LogImport/GNUmakefile b/src/perl/LogImport/GNUmakefile new file mode 100644 index 0000000..d7b4dec --- /dev/null +++ b/src/perl/LogImport/GNUmakefile @@ -0,0 +1,71 @@ +#!gmake +# +# Copyright (c) 2008 Aconex. All Rights Reserved. +# Copyright (c) 2004 Silicon Graphics, Inc. All Rights Reserved. +# +# This program is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation; either version 2 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# +# You should have received a copy of the GNU General Public License along +# with this program; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +# + +TOPDIR = ../../.. +include $(TOPDIR)/src/include/builddefs + +PERLMOD = LogImport.pm +INTERFACE = LogImport.xs typemap +TESTCODE = +PERLDOCS = Changes MANIFEST +LSRCFILES = Makefile.PL $(PERLDOCS) $(PERLMOD) $(INTERFACE) $(TESTCODE) + +LPKGDIRT = PCP-LogImport-* tmp MYMETA.yml MYMETA.json +LDIRT = Makefile COPYING LogImport.bs LogImport.c LogImport.o cvalue pm_to_blib blib \ + Makefile.old $(LPKGDIRT) + +default: dist + +MAKEMAKER_OPTIONS = INSTALLDIRS=$(PERL_INSTALLDIRS) INSTALLVENDORMAN3DIR=$(PCP_MAN_DIR)/man3 +INSTALLER_OPTIONS = DESTDIR=$$DIST_ROOT + +ifeq ($(TARGET_OS),mingw) +PERLMAKE = dmake.exe +else +PERLMAKE = $(MAKE) +endif + +LogImport.o: Makefile LogImport.xs typemap + $(PERLMAKE) -f Makefile + +Makefile: COPYING Makefile.PL + $(call PERL_MAKE_MAKEFILE) + +COPYING: + $(LN_S) $(TOPDIR)/COPYING COPYING + +test dist: LogImport.o + rm -rf $(LPKGDIRT) + $(PERLMAKE) -f Makefile $@ + +include $(BUILDRULES) + +install: default +ifneq "$(PACKAGE_DISTRIBUTION)" "debian" + $(call PERL_GET_FILELIST,$(TOPDIR)/perl-pcp-logimport.list,LogImport) +endif + +install_perl: + $(PERLMAKE) -f Makefile pure_install $(INSTALLER_OPTIONS) + +default_pcp: default + +install_pcp: install + diff --git a/src/perl/LogImport/LogImport.pm b/src/perl/LogImport/LogImport.pm new file mode 100644 index 0000000..92eaba3 --- /dev/null +++ b/src/perl/LogImport/LogImport.pm @@ -0,0 +1,190 @@ +package PCP::LogImport; + +use strict; +use warnings; + +require Exporter; +require DynaLoader; + +our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); + +@ISA = qw( Exporter DynaLoader ); +@EXPORT = qw( + pmiStart pmiUseContext pmiEnd pmiSetHostname pmiSetTimezone + pmiAddMetric pmiAddInstance pmiPutValue pmiGetHandle pmiPutValueHandle + pmiWrite + pmiDump pmiErrStr pmiUnits pmiID pmiInDom + pmid_build pmInDom_build + pmiBatchPutValue pmiBatchPutValueHandle pmiBatchWrite pmiBatchEnd + PM_ID_NULL PM_INDOM_NULL PM_IN_NULL + PM_SPACE_BYTE PM_SPACE_KBYTE PM_SPACE_MBYTE PM_SPACE_GBYTE PM_SPACE_TBYTE + PM_TIME_NSEC PM_TIME_USEC PM_TIME_MSEC PM_TIME_SEC PM_TIME_MIN PM_TIME_HOUR + PM_COUNT_ONE + PM_TYPE_NOSUPPORT PM_TYPE_32 PM_TYPE_U32 PM_TYPE_64 PM_TYPE_U64 + PM_TYPE_FLOAT PM_TYPE_DOUBLE PM_TYPE_STRING + PM_SEM_COUNTER PM_SEM_INSTANT PM_SEM_DISCRETE + PMI_DOMAIN +); +%EXPORT_TAGS = qw(); +@EXPORT_OK = qw(); + +# set the version for version checking +$VERSION = '1.02'; + +# metric identification +sub PM_ID_NULL { 0xffffffff; } +sub PM_INDOM_NULL { 0xffffffff; } +sub PM_IN_NULL { 0xffffffff; } + +# units - space scale +sub PM_SPACE_BYTE { 0; } # bytes +sub PM_SPACE_KBYTE { 1; } # kilobytes +sub PM_SPACE_MBYTE { 2; } # megabytes +sub PM_SPACE_GBYTE { 3; } # gigabytes +sub PM_SPACE_TBYTE { 4; } # terabytes + +# units - time scale +sub PM_TIME_NSEC { 0; } # nanoseconds +sub PM_TIME_USEC { 1; } # microseconds +sub PM_TIME_MSEC { 2; } # milliseconds +sub PM_TIME_SEC { 3; } # seconds +sub PM_TIME_MIN { 4; } # minutes +sub PM_TIME_HOUR { 5; } # hours + +# units - count scale (for metrics such as count events, syscalls, +# interrupts, etc - these are simply powers of ten and not enumerated here +# (e.g. 6 for 10^6, or -3 for 10^-3). +sub PM_COUNT_ONE { 0; } # 1 + +# data type of metric values +sub PM_TYPE_NOSUPPORT { 0xffffffff; } # not implemented in this version +sub PM_TYPE_32 { 0; } # 32-bit signed integer +sub PM_TYPE_U32 { 1; } # 32-bit unsigned integer +sub PM_TYPE_64 { 2; } # 64-bit signed integer +sub PM_TYPE_U64 { 3; } # 64-bit unsigned integer +sub PM_TYPE_FLOAT { 4; } # 32-bit floating point +sub PM_TYPE_DOUBLE { 5; } # 64-bit floating point +sub PM_TYPE_STRING { 6; } # array of characters + +# semantics/interpretation of metric values +sub PM_SEM_COUNTER { 1; } # cumulative counter (monotonic increasing) +sub PM_SEM_INSTANT { 3; } # instantaneous value, continuous domain +sub PM_SEM_DISCRETE { 4; } # instantaneous value, discrete domain + +# reserved domain (see $PCP_VAR_DIR/pmns/stdpmid) +sub PMI_DOMAIN { 245; } + +# error codes +sub PMI_ERR_DUPMETRICNAME { -20001; } +sub PMI_ERR_DUPMETRICID { -20002; } # Metric pmID already defined +sub PMI_ERR_DUPINSTNAME { -20003; } # External instance name already defined +sub PMI_ERR_DUPINSTID { -20004; } # Internal instance identifer already defined +sub PMI_ERR_INSTNOTNULL { -20005; } # Non-null instance expected for a singular metric +sub PMI_ERR_INSTNULL { -20006; } # Null instance not allowed for a non-singular metric +sub PMI_ERR_BADHANDLE { -20007; } # Illegal handle +sub PMI_ERR_DUPVALUE { -20008; } # Value already assigned for singular metric +sub PMI_ERR_BADTYPE { -20009; } # Illegal metric type +sub PMI_ERR_BADSEM { -20010; } # Illegal metric semantics +sub PMI_ERR_NODATA { -20011; } # No data to output +sub PMI_ERR_BADMETRICNAME { -20012; } # Illegal metric name +sub PMI_ERR_BADTIMESTAMP { -20013; } # Illegal result timestamp + +# Batch operations +our %pmi_batch = (); + +sub pmiBatchPutValue($$$) { + my ($name, $instance, $value) = @_; + push @{$pmi_batch{'b'}}, [ $name, $instance, $value ]; + return 0; +} + +sub pmiBatchPutValueHandle($$) { + my ($handle, $value) = @_; + push @{$pmi_batch{'b'}}, [ $handle, $value ]; + return 0; +} + +sub pmiBatchWrite($$) { + my ($sec, $usec) = @_; + push @{$pmi_batch{"$sec.$usec"}}, @{delete $pmi_batch{'b'}}; + return 0; +} + +sub pmiBatchEnd() { + my ($arr, $r); + my $ts = -1; + # Iterate over the sorted hash and call pmiPutValue/pmiWrite accordingly + delete $pmi_batch{'b'}; + for my $k (map { $_->[0] } + sort { $a->[1] <=> $b->[1] || $a->[2] <=> $b->[2] } + map { [$_, /(\d+)\.(\d+)/] } + keys %pmi_batch) { + $arr = $pmi_batch{$k}; + $ts = $k if $ts eq -1; + if ($k > $ts) { + $r = pmiWrite(split(/\./, $ts)); + return $r if ($r != 0); + $ts = $k; + } + for my $v (@$arr) { + if (defined($v->[2])) { + $r = pmiPutValue($v->[0], $v->[1], $v->[2]); + } else { + $r = pmiPutValueHandle($v->[0], $v->[1]); + } + return $r if ($r != 0); + } + } + $r = pmiWrite(split(/\./, $ts)); + return $r if ($r != 0); + %pmi_batch = (); + return 0; +} + +bootstrap PCP::LogImport $VERSION; + +1; # don't forget to return a true value from the file + +__END__ + +=head1 NAME + +PCP::LogImport - Perl module for importing performance data to create a Performance Co-Pilot archive + +=head1 SYNOPSIS + + use PCP::LogImport; + +=head1 DESCRIPTION + +The PCP::LogImport module contains the language bindings for building +Perl applications that import performance data from a file or real-time +source and create a Performance Co-Pilot (PCP) archive suitable for use +with the PCP tools. + +The routines in this module provide wrappers around the libpcp_import +library. + +=head1 SEE ALSO + +pmiAddInstance(3), pmiAddMetric(3), pmiEnd(3), pmiErrStr(3), +pmiGetHandle(3), pmiPutResult(3), pmiPutValue(3), pmiPutValueHandle(3), +pmiStart(3), pmiSetHostname(3), pmiSetTimezone(3), pmiUnits(3), +pmiUseContext(3) and pmiWrite(3). + +The PCP mailing list pcp@mail.performancecopilot.org can be used for +questions about this module. + +Further details can be found at http://www.performancecopilot.org + +=head1 AUTHOR + +Ken McDonell, E<lt>kenj@internode.on.netE<gt> + +Copyright (C) 2010 by Ken McDonell. + +This library is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License, version 2 (see +the "COPYING" file in the PCP source tree for further details). + +=cut diff --git a/src/perl/LogImport/LogImport.xs b/src/perl/LogImport/LogImport.xs new file mode 100644 index 0000000..3ee9d2d --- /dev/null +++ b/src/perl/LogImport/LogImport.xs @@ -0,0 +1,129 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include <pmapi.h> +#include <impl.h> +#include <import.h> + +MODULE = PCP::LogImport PACKAGE = PCP::LogImport + +# helper methods +# + +# name here is a little odd ... follows impl.h definition rather +# than pmi* naming so calls from C and Perl are the same +pmID +pmid_build(domain, cluster, item) + unsigned int domain; + unsigned int cluster; + unsigned int item; + CODE: + pmID id; + __pmid_int(&id)->flag = 0; + __pmid_int(&id)->domain = domain; + __pmid_int(&id)->cluster = cluster; + __pmid_int(&id)->item = item; + RETVAL = id; + OUTPUT: + RETVAL + +# name here is a little odd ... follows impl.h definition rather +# than pmi* naming so calls from C and Perl are the same +pmInDom +pmInDom_build(domain, serial) + unsigned int domain; + unsigned int serial; + CODE: + pmInDom indom; + __pmindom_int(&indom)->flag = 0; + __pmindom_int(&indom)->domain = domain; + __pmindom_int(&indom)->serial = serial; + RETVAL = indom; + OUTPUT: + RETVAL + +# libpcp_import wrappers +# + +void +pmiDump() + +pmUnits +pmiUnits(dimSpace, dimTime, dimCount, scaleSpace, scaleTime, scaleCount) + int dimSpace; + int dimTime; + int dimCount; + int scaleSpace; + int scaleTime; + int scaleCount; + +pmID +pmiID(domain, cluster, item) + int domain; + int cluster; + int item; + +pmInDom +pmiInDom(domain, serial) + int domain; + int serial; + +const char * +pmiErrStr(sts) + int sts; + +int +pmiStart(archive, inherit) + char *archive; + int inherit; + +int +pmiUseContext(context) + int context; + +int +pmiEnd() + +int +pmiSetHostname(value) + char *value; + +int +pmiSetTimezone(value) + char *value; + +int +pmiAddMetric(name, pmid, type, indom, sem, units) + const char *name; + pmID pmid; + int type; + pmInDom indom; + int sem; + pmUnits units; + +int +pmiAddInstance(indom, instance, inst) + pmInDom indom; + const char *instance; + int inst; + +int +pmiPutValue(name, instance, value) + const char *name; + const char *instance; + const char *value; + +int +pmiGetHandle(name, instance) + const char *name; + const char *instance; + +int +pmiPutValueHandle(handle, value) + int handle; + const char *value; + +int +pmiWrite(sec, usec) + int sec; + int usec; diff --git a/src/perl/LogImport/MANIFEST b/src/perl/LogImport/MANIFEST new file mode 100644 index 0000000..61c6108 --- /dev/null +++ b/src/perl/LogImport/MANIFEST @@ -0,0 +1,7 @@ +Changes +COPYING +Makefile.PL +MANIFEST +LogImport.pm +LogImport.xs +typemap diff --git a/src/perl/LogImport/Makefile.PL b/src/perl/LogImport/Makefile.PL new file mode 100644 index 0000000..20b716d --- /dev/null +++ b/src/perl/LogImport/Makefile.PL @@ -0,0 +1,49 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +my $ldfrom; +my $inc; +my $libs; +my $lddlflags; +my $cccdlflags; + +if ($ENV{TARGET_OS} eq "mingw") { + $ldfrom = "-L$ENV{PCP_TOPDIR}/src/libpcp/src -L$ENV{PCP_TOPDIR}/src/libpcp_import/src -L$ENV{PCP_DIR}\\local\\bin -lpcp_import -lpcp LogImport.o", + $inc = "-I$ENV{PCP_TOPDIR}/src/include/pcp -I/usr/include/pcp -I$ENV{PCP_DIR}\\include\\pcp -I$ENV{PCP_DIR}\\c\\include"; + $libs = ["-L$ENV{PCP_DIR}\\local\\bin", '-lpcp_import', '-lpcp']; +} +else { + $ldfrom = "LogImport.o", + $inc = "-I$ENV{PCP_TOPDIR}/src/include/pcp -I/usr/include/pcp"; + $libs = ["-L$ENV{PCP_TOPDIR}/src/libpcp/src -L$ENV{PCP_TOPDIR}/src/libpcp_import/src -lpcp_import -lpcp"]; +} +if ($ENV{TARGET_OS} eq "darwin") { + # standard ones, minus -arch ppc + $lddlflags = "-arch x86_64 -arch i386 -bundle -undefined dynamic_lookup"; +} +else { + $lddlflags = "-shared \$(OPTIMIZE) \$(LDFLAGS)"; +} +if ($ENV{TARGET_OS} eq "solaris") { + # for OpenSolaris Makefile ends up with -KPIC instead of -fPIC otherwise + $cccdlflags = "-fPIC" +} + +WriteMakefile( + NAME => 'PCP::LogImport', + AUTHOR => 'Ken McDonell <kenj@internode.on.net>', + VERSION_FROM => 'LogImport.pm', # finds $VERSION + ABSTRACT_FROM => 'LogImport.pm', # retrieve abstract from module + C => ['LogImport.c'], + OPTIMIZE => '-g', + XSPROTOARG => '-noprototypes', + OBJECT => 'LogImport.o', + DEFINE => '-DPERLIO_NOT_STDIO=0 -DPCP_VERSION -DPCP_DEBUG', + LDFROM => $ldfrom, + LDDLFLAGS => $lddlflags, + CCCDLFLAGS => $cccdlflags, + INC => $inc, + LIBS => $libs, + CC => $ENV{"CC"}, + LD => $ENV{"CC"}, +); diff --git a/src/perl/LogImport/typemap b/src/perl/LogImport/typemap new file mode 100644 index 0000000..162308b --- /dev/null +++ b/src/perl/LogImport/typemap @@ -0,0 +1,24 @@ +###################################################################### +# INPUT/OUTPUT maps +# O_OBJECT -> links an opaque C object to a blessed Perl object. +# +TYPEMAP +pmUnits T_INT_EQUIV +pmID T_INT_EQUIV +pmInDom T_INT_EQUIV + +###################################################################### +INPUT +# struct or typedef that is really the same size as a 32-bit integer +T_INT_EQUIV + { + __int32_t tmp = SvIV($arg); + memcpy((void *)&$var, (void *)&tmp, sizeof(__int32_t)); + } + +###################################################################### +OUTPUT +# struct or typedef that is really the same size as a 32-bit integer +T_INT_EQUIV + sv_setiv($arg, *((int *)&$var)); +###################################################################### diff --git a/src/perl/LogSummary/Changes b/src/perl/LogSummary/Changes new file mode 100644 index 0000000..e2c8ffe --- /dev/null +++ b/src/perl/LogSummary/Changes @@ -0,0 +1,8 @@ +Revision history for Perl extension PCP::LogSummary. + +1.01 Web Mar 4 10:48:37 2009 + - updated excel-export demo to remove unwanted dependency + +1.00 Fri Nov 28 09:20:55 2008 + - original version created + diff --git a/src/perl/LogSummary/GNUmakefile b/src/perl/LogSummary/GNUmakefile new file mode 100644 index 0000000..3411826 --- /dev/null +++ b/src/perl/LogSummary/GNUmakefile @@ -0,0 +1,62 @@ +#!gmake +# +# Copyright (c) 2008 Aconex. All Rights Reserved. +# +# This program is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation; either version 2 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# + +TOPDIR = ../../.. +include $(TOPDIR)/src/include/builddefs + +PERLMOD = LogSummary.pm +PERLDOCS = Changes MANIFEST README +PERLCODE = extract.pl exceldemo.pl +LSRCFILES = Makefile.PL $(PERLDOCS) $(PERLMOD) $(PERLCODE) +SUBDIRS = t + +LPKGDIRT = PCP-LogSummary-* MYMETA.yml MYMETA.json +LDIRT = Makefile COPYING pm_to_blib blib Makefile.old $(LPKGDIRT) *.xls + +default: dist + +MAKEMAKER_OPTIONS = INSTALLDIRS=$(PERL_INSTALLDIRS) INSTALLVENDORMAN3DIR=$(PCP_MAN_DIR)/man3 +INSTALLER_OPTIONS = DESTDIR=$$DIST_ROOT + +ifeq ($(TARGET_OS),mingw) +PERLMAKE = dmake.exe +else +PERLMAKE = $(MAKE) +endif + +Makefile: COPYING Makefile.PL + $(call PERL_MAKE_MAKEFILE) + +COPYING: + $(LN_S) $(TOPDIR)/COPYING COPYING + +test dist: Makefile + rm -f $(LPKGDIRT) + $(PERLMAKE) -f Makefile $@ + +include $(BUILDRULES) + +install: default +ifneq "$(PACKAGE_DISTRIBUTION)" "debian" + $(call PERL_GET_FILELIST,$(TOPDIR)/perl-pcp-logsummary.list,LogSummary) +endif + +install_perl: + $(PERLMAKE) -f Makefile pure_install $(INSTALLER_OPTIONS) + +default_pcp: default + +install_pcp: install + diff --git a/src/perl/LogSummary/LogSummary.pm b/src/perl/LogSummary/LogSummary.pm new file mode 100644 index 0000000..a5f2c36 --- /dev/null +++ b/src/perl/LogSummary/LogSummary.pm @@ -0,0 +1,117 @@ +package PCP::LogSummary; + +use strict; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); + +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(new metric_instance); +@EXPORT_OK = qw( ); +$VERSION = '1.01'; + +sub new +{ + my ( $self, $archive, $metricsref, $start, $finish ) = @_; + my $opts = '-F -N -z -biImMy -p6'; + my @metrica = @{$metricsref}; + my $metrics = ' '; + my %results; + + foreach my $m (@metrica) { $metrics .= $m . ' '; } + if (defined($start)) { $opts .= " -S'$start'"; } + if (defined($finish)) { $opts .= " -T'$finish'"; } + + open SUMMARY, "pmlogsummary $opts $archive $metrics |" + || die "pmlogsummary: $!\n"; + + # metric,[inst],stocavg,timeavg,minimum,mintime,maximum,maxtime,count,units + LINE: while (<SUMMARY>) { + # print "Input line: $_\n"; + m/^(\S.+),(.*),(\S+),(\S+),(\S+),(.+),(\S+),(.+),(\S+),(.*)$/ + || next LINE; + + # If counter metric doesn't cover 90% of archive, metric name + # is preceded by an asterix. Chop this off and set a flag. + my $metric = $1; + $metric =~ s/^\*//; + my $asterix = ($metric ne $1); + + my %result; + $result{'average'} = $3; + $result{'timeavg'} = $4; + $result{'minimum'} = $5; + $result{'mintime'} = $6; + $result{'maximum'} = $7; + $result{'maxtime'} = $8; + $result{'samples'} = $9; + $result{'units'} = $10; + $result{'ninety%'} = $asterix; + + my $key = $1; + if ($2 ne "") { $key .= $2; } + $results{$key} = \%result; + + # print "key=", $key, " average=$3\n"; + } + close SUMMARY; + return \%results; +} + +sub metric_instance +{ + my ( $metric, $instance ) = @_; + return "$metric\[\"$instance\"\]"; +} + +1; +__END__ + +=head1 NAME + +PCP::LogSummary - Perl interface for pmlogsummary(1) + +=head1 SYNOPSIS + + use PCP::LogSummary; + + my $summary = new PCP::LogSummary($log, \@metrics, $start, $end); + +=head1 DESCRIPTION + +The PCP::LogSummary module is a wrapper around the Performance Co-Pilot +pmlogsummary(1) command. +Its primary purpose is to automate the production of post-processed +pmlogsummary data, in particular to automate the step where the +summarised data is imported into a spreadsheet for further anaylsis. +This has proven to often be an iterative process - done manually it +involves much cutting+pasting, and can be a significant time waster. + +=head2 EXPORT + +new + +metric_instance + +=head1 SEE ALSO + +pmlogsummary(1). + +The PCP mailing list pcp@mail.performancecopilot.org can be used for +questions about this module. + +Further details can be found at http://www.performancecopilot.org + +=head1 AUTHOR + +Nathan Scott, E<lt>nathans@debian.orgE<gt> + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2008 by Aconex + +This library is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License, version 2 (see +the "COPYING" file in the PCP source tree for further details). + +=cut diff --git a/src/perl/LogSummary/MANIFEST b/src/perl/LogSummary/MANIFEST new file mode 100644 index 0000000..df94fca --- /dev/null +++ b/src/perl/LogSummary/MANIFEST @@ -0,0 +1,20 @@ +Changes +Makefile.PL +MANIFEST +README +LogSummary.pm +extract.pl +exceldemo.pl +t/test.t +t/app/20081125.index +t/app/20081125.meta +t/app/20081125.0 +t/app/20081126.index +t/app/20081126.meta +t/app/20081126.0 +t/db/20081125.index +t/db/20081125.meta +t/db/20081125.0 +t/db/20081126.index +t/db/20081126.meta +t/db/20081126.0 diff --git a/src/perl/LogSummary/Makefile.PL b/src/perl/LogSummary/Makefile.PL new file mode 100644 index 0000000..89f0436 --- /dev/null +++ b/src/perl/LogSummary/Makefile.PL @@ -0,0 +1,9 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + NAME => 'PCP::LogSummary', + AUTHOR => 'Nathan Scott <nathans@debian.org>', + VERSION_FROM => 'LogSummary.pm', # finds $VERSION + ABSTRACT_FROM => 'LogSummary.pm', # retrieve abstract from module +); diff --git a/src/perl/LogSummary/README b/src/perl/LogSummary/README new file mode 100644 index 0000000..dd11f5f --- /dev/null +++ b/src/perl/LogSummary/README @@ -0,0 +1,32 @@ +PCP-LogSummary version 1.00 +=========================== + +The PCP::LogSummary module is a wrapper around the PCP pmlogsummary(1) +command. Its primary purpose is to automate the production of post- +processed pmlogsummary data, in particular to automate the step where +the summarised data is imported into a spreadsheet for further anaylsis. +This has proven to often be an iterative process - when done manually +it involves much cutting+pasting and can be a significant time waster. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires no other Perl modules and libraries, but does +obviously require a working Performance Co-Pilot installation. + +COPYRIGHT AND LICENCE + +Copyright (C) 2008 by Aconex + +This library is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License, version 2 (see +the "COPYING" file in the PCP source tree for further details). + diff --git a/src/perl/LogSummary/exceldemo.pl b/src/perl/LogSummary/exceldemo.pl new file mode 100644 index 0000000..1aed252 --- /dev/null +++ b/src/perl/LogSummary/exceldemo.pl @@ -0,0 +1,89 @@ +# A demo script which interfaces the LogSummary Perl module to the +# WriteExcel module, with some real data, to show what it can do. +# Author: Nathan Scott <nathans@debian.org> +# Note: No #! line, as this pulls in an external dependency that +# we really don't want in packaging tools like rpm. + +use strict; +use warnings; +use PCP::LogSummary; +use Spreadsheet::WriteExcel; + +my @app = ('aconex.response_time.samples', 'aconex.response_time.adjavg'); +my @db = ('kernel.all.cpu.user', 'kernel.all.cpu.sys', 'kernel.all.cpu.intr'); +my @dbdisk = ('disk.dev.idle', 'disk.dev.read_bytes'); + +my ( $dblog1, $dblog2 ) = ('t/db/20081125', 't/db/20081126'); +my $dbdisk_before = PCP::LogSummary->new($dblog1, \@dbdisk); +my $dbdisk_after = PCP::LogSummary->new($dblog2, \@dbdisk); +my $dbcpu_before = PCP::LogSummary->new($dblog1, \@db); +my $dbcpu_after = PCP::LogSummary->new($dblog2, \@db); + +my ( $applog1, $applog2 ) = ('t/app/20081125', 't/app/20081126'); +my $app_before = PCP::LogSummary->new($applog1, \@app); +my $app_after = PCP::LogSummary->new($applog2, \@app); + +my $workbook = Spreadsheet::WriteExcel->new('new-dxb-dbserver.xls'); + +my $heading = $workbook->add_format(); +$heading->set_bold(); +$heading->set_italic(); +my $subheading = $workbook->add_format(); +$subheading->set_italic(); +$subheading->set_bg_color('silver'); +my $unitscolumn = $workbook->add_format(); +$unitscolumn->set_align('center'); + +my $sheet = $workbook->add_worksheet(); +my ( $precol, $postcol, $units ) = ( 1, 2, 3 ); +$sheet->set_column('A:A', 32); # metric names column +$sheet->set_column('B:B', 14); # column for "Before" values +$sheet->set_column('C:C', 14); # column for "After" values +$sheet->set_column('D:D', 12); # metrics units column + +my $row = 0; +$sheet->write($row, 0, 'Dubai Database Storage Upgrade', $heading); +$row = 2; +$sheet->write($row, 0, 'Metrics', $subheading); +$sheet->write($row, $precol, 'Before', $subheading); +$sheet->write($row, $postcol, 'After', $subheading); +$sheet->write($row, $units, 'Units', $subheading); + +foreach my $m ( @app ) { + my $metric = metric_instance($m, 'dxb'); + $row++; + $sheet->write($row, 0, $metric); + $sheet->write($row, $precol, $$app_before{$metric}{'average'}); + $sheet->write($row, $postcol, $$app_after{$metric}{'average'}); + $sheet->write($row, $units, $$app_after{$metric}{'units'}, $unitscolumn); +} +foreach my $m ( @dbdisk ) { + my $metric = metric_instance($m, 'G:'); # Windows drive letter + $row++; + $sheet->write($row, 0, $metric); + $sheet->write($row, $precol, $$dbdisk_before{$metric}{'average'}); + $sheet->write($row, $postcol, $$dbdisk_after{$metric}{'average'}); + $sheet->write($row, $units, $$dbdisk_after{$metric}{'units'}, $unitscolumn); +} + +# Report CPU metrics as a single utilisation value +{ + my $syscpu1 = $$dbcpu_before{'kernel.all.cpu.sys'}; + my $intcpu1 = $$dbcpu_before{'kernel.all.cpu.intr'}; + my $usrcpu1 = $$dbcpu_before{'kernel.all.cpu.user'}; + my $syscpu2 = $$dbcpu_after{'kernel.all.cpu.sys'}; + my $intcpu2 = $$dbcpu_after{'kernel.all.cpu.intr'}; + my $usrcpu2 = $$dbcpu_after{'kernel.all.cpu.user'}; + my $ncpu = 4; + + my $cpu_before = $ncpu * ( $$syscpu1{'average'} + + $$intcpu1{'average'} + $$usrcpu1{'average'} ); + my $cpu_after = $ncpu * ( $$syscpu2{'average'} + + $$intcpu2{'average'} + $$usrcpu2{'average'} ); + + $row++; + $sheet->write($row, 0, 'kernel.all.cpu'); + $sheet->write($row, $precol, $cpu_before * 100.0); + $sheet->write($row, $postcol, $cpu_after * 100.0); + $sheet->write($row, $units, 'percent', $unitscolumn); +} diff --git a/src/perl/LogSummary/extract.pl b/src/perl/LogSummary/extract.pl new file mode 100755 index 0000000..1165a7b --- /dev/null +++ b/src/perl/LogSummary/extract.pl @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use PCP::LogSummary; + +my $archive = 't/db/20081125'; +my @metrics = ( 'kernel.all.cpu.user', 'kernel.all.cpu.idle', + 'kernel.all.cpu.intr', 'kernel.all.cpu.sys' ); +my $results = PCP::LogSummary->new($archive, \@metrics, '@09:00', '@17:00'); +#my $results = PCP::LogSummary->new($archive, \@metrics); + +foreach my $metric ( keys %$results ) { + my $summary = $$results{$metric}; + print "metric=", $metric, "\n"; + print " average=", $$summary{'average'}, "\n"; + print " samples=", $$summary{'samples'}, "\n"; +} diff --git a/src/perl/LogSummary/t/GNUmakefile b/src/perl/LogSummary/t/GNUmakefile new file mode 100644 index 0000000..6c00e8d --- /dev/null +++ b/src/perl/LogSummary/t/GNUmakefile @@ -0,0 +1,12 @@ +TOPDIR = ../../../.. +include $(TOPDIR)/src/include/builddefs +LSRCFILES = test.t +SUBDIRS = app db + +default: + +include $(BUILDRULES) + +install: + +default_pcp install_pcp: diff --git a/src/perl/LogSummary/t/app/20081125.0 b/src/perl/LogSummary/t/app/20081125.0 Binary files differnew file mode 100644 index 0000000..43e5f4a --- /dev/null +++ b/src/perl/LogSummary/t/app/20081125.0 diff --git a/src/perl/LogSummary/t/app/20081125.index b/src/perl/LogSummary/t/app/20081125.index Binary files differnew file mode 100644 index 0000000..76eb3b9 --- /dev/null +++ b/src/perl/LogSummary/t/app/20081125.index diff --git a/src/perl/LogSummary/t/app/20081125.meta b/src/perl/LogSummary/t/app/20081125.meta Binary files differnew file mode 100644 index 0000000..5007180 --- /dev/null +++ b/src/perl/LogSummary/t/app/20081125.meta diff --git a/src/perl/LogSummary/t/app/20081126.0 b/src/perl/LogSummary/t/app/20081126.0 Binary files differnew file mode 100644 index 0000000..9563c3c --- /dev/null +++ b/src/perl/LogSummary/t/app/20081126.0 diff --git a/src/perl/LogSummary/t/app/20081126.index b/src/perl/LogSummary/t/app/20081126.index Binary files differnew file mode 100644 index 0000000..d5d7fa6 --- /dev/null +++ b/src/perl/LogSummary/t/app/20081126.index diff --git a/src/perl/LogSummary/t/app/20081126.meta b/src/perl/LogSummary/t/app/20081126.meta Binary files differnew file mode 100644 index 0000000..b60336c --- /dev/null +++ b/src/perl/LogSummary/t/app/20081126.meta diff --git a/src/perl/LogSummary/t/app/GNUmakefile b/src/perl/LogSummary/t/app/GNUmakefile new file mode 100644 index 0000000..8309f9c --- /dev/null +++ b/src/perl/LogSummary/t/app/GNUmakefile @@ -0,0 +1,13 @@ +TOPDIR = ../../../../.. +include $(TOPDIR)/src/include/builddefs +LSRCFILES = \ + 20081125.meta 20081125.index 20081125.0 \ + 20081126.meta 20081126.index 20081126.0 + +default: + +include $(BUILDRULES) + +install: + +default_pcp install_pcp: diff --git a/src/perl/LogSummary/t/db/20081125.0 b/src/perl/LogSummary/t/db/20081125.0 Binary files differnew file mode 100644 index 0000000..5c8d606 --- /dev/null +++ b/src/perl/LogSummary/t/db/20081125.0 diff --git a/src/perl/LogSummary/t/db/20081125.index b/src/perl/LogSummary/t/db/20081125.index Binary files differnew file mode 100644 index 0000000..450dd1a --- /dev/null +++ b/src/perl/LogSummary/t/db/20081125.index diff --git a/src/perl/LogSummary/t/db/20081125.meta b/src/perl/LogSummary/t/db/20081125.meta Binary files differnew file mode 100644 index 0000000..52f8376 --- /dev/null +++ b/src/perl/LogSummary/t/db/20081125.meta diff --git a/src/perl/LogSummary/t/db/20081126.0 b/src/perl/LogSummary/t/db/20081126.0 Binary files differnew file mode 100644 index 0000000..758c6ae --- /dev/null +++ b/src/perl/LogSummary/t/db/20081126.0 diff --git a/src/perl/LogSummary/t/db/20081126.index b/src/perl/LogSummary/t/db/20081126.index Binary files differnew file mode 100644 index 0000000..eac9dbb --- /dev/null +++ b/src/perl/LogSummary/t/db/20081126.index diff --git a/src/perl/LogSummary/t/db/20081126.meta b/src/perl/LogSummary/t/db/20081126.meta Binary files differnew file mode 100644 index 0000000..835e3be --- /dev/null +++ b/src/perl/LogSummary/t/db/20081126.meta diff --git a/src/perl/LogSummary/t/db/GNUmakefile b/src/perl/LogSummary/t/db/GNUmakefile new file mode 100644 index 0000000..8309f9c --- /dev/null +++ b/src/perl/LogSummary/t/db/GNUmakefile @@ -0,0 +1,13 @@ +TOPDIR = ../../../../.. +include $(TOPDIR)/src/include/builddefs +LSRCFILES = \ + 20081125.meta 20081125.index 20081125.0 \ + 20081126.meta 20081126.index 20081126.0 + +default: + +include $(BUILDRULES) + +install: + +default_pcp install_pcp: diff --git a/src/perl/LogSummary/t/test.t b/src/perl/LogSummary/t/test.t new file mode 100644 index 0000000..816c114 --- /dev/null +++ b/src/perl/LogSummary/t/test.t @@ -0,0 +1,41 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use Test; +BEGIN { plan tests => 15 }; +use PCP::LogSummary; +ok(1); # If we made it this far, we're ok. + +######################### + +my $archive = 't/db/20081125'; +my @metrics = ( 'kernel.all.cpu.user', 'kernel.all.cpu.sys' ); +my $results = PCP::LogSummary->new($archive, \@metrics); +ok(1, defined($results), "log summarised"); + +foreach my $metric ( sort keys %$results ) { + my $summary = $$results{$metric}; + #print("metric=", $metric, "\n"); + #print(" average=", $$summary{'average'}, "\n"); + #print(" samples=", $$summary{'samples'}, "\n"); + ok(1, ($$summary{'samples'} == 5758), "samples verified"); + ok(1, ($$summary{'average'} > 0), "average lower bounds check"); + ok(1, ($$summary{'average'} < 1), "average upper bounds check") ; +} + +$results = PCP::LogSummary->new($archive, \@metrics, '@09:00', '@17:00'); +ok(1, defined($results), "restricted log summarised"); + +foreach my $metric ( sort keys %$results ) { + my $summary = $$results{$metric}; + #print("metric=", $metric, "\n"); + #print(" average=", $$summary{'average'}, "\n"); + #print(" samples=", $$summary{'samples'}, "\n"); + ok(1, ($$summary{'samples'} == 1919), "restricted samples verified"); + ok(1, ($$summary{'average'} > 0), "average lower bounds check"); + ok(1, ($$summary{'average'} < 1), "average upper bounds check") ; +} diff --git a/src/perl/MMV/Changes b/src/perl/MMV/Changes new file mode 100644 index 0000000..a799519 --- /dev/null +++ b/src/perl/MMV/Changes @@ -0,0 +1,12 @@ +Revision history for Perl extension PCP::MMV. + +1.00 Mon Aug 24 08:52:36 EST 2009 + - added stop interface + - added stats_set interface + - fixed incorrect memory free on init + - extend server.pl example to report idle time + - fixed use of av_len return codes (off by one) + +0.01 Fri Jun 12 16:55:20 EST 2009 + - original version + diff --git a/src/perl/MMV/GNUmakefile b/src/perl/MMV/GNUmakefile new file mode 100644 index 0000000..1fc485d --- /dev/null +++ b/src/perl/MMV/GNUmakefile @@ -0,0 +1,67 @@ +#!gmake +# +# Copyright (c) 2009 Aconex. All Rights Reserved. +# +# This program is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation; either version 2 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# + +TOPDIR = ../../.. +include $(TOPDIR)/src/include/builddefs + +PERLMOD = MMV.pm +INTERFACE = MMV.xs typemap +TESTCODE = test.pl server.pl +PERLDOCS = Changes MANIFEST +LSRCFILES = Makefile.PL $(PERLDOCS) $(PERLMOD) $(INTERFACE) $(TESTCODE) + +LPKGDIRT = PCP-MMV-* MYMETA.yml MYMETA.json +LDIRT = Makefile COPYING MMV.bs MMV.c MMV.o pm_to_blib blib \ + Makefile.old $(LPKGDIRT) + +default: dist + +MAKEMAKER_OPTIONS = INSTALLDIRS=$(PERL_INSTALLDIRS) INSTALLVENDORMAN3DIR=$(PCP_MAN_DIR)/man3 +INSTALLER_OPTIONS = DESTDIR=$$DIST_ROOT + +ifeq ($(TARGET_OS),mingw) +PERLMAKE = dmake.exe +else +PERLMAKE = $(MAKE) +endif + +MMV.o: Makefile MMV.xs + $(PERLMAKE) -f Makefile + +Makefile: COPYING Makefile.PL + $(call PERL_MAKE_MAKEFILE) + +COPYING: + $(LN_S) $(TOPDIR)/COPYING COPYING + +test dist: MMV.o + rm -f $(LPKGDIRT) + $(PERLMAKE) -f Makefile $@ + +include $(BUILDRULES) + +install: default +ifneq "$(PACKAGE_DISTRIBUTION)" "debian" + $(call PERL_GET_FILELIST,$(TOPDIR)/perl-pcp-mmv.list,MMV) + find $$DIST_ROOT -name server.pl -exec chmod 755 '{}' ';' +endif + +install_perl: + $(PERLMAKE) -f Makefile pure_install $(INSTALLER_OPTIONS) + +default_pcp: default + +install_pcp: install + diff --git a/src/perl/MMV/MANIFEST b/src/perl/MMV/MANIFEST new file mode 100644 index 0000000..1551ac8 --- /dev/null +++ b/src/perl/MMV/MANIFEST @@ -0,0 +1,9 @@ +Changes +COPYING +Makefile.PL +MANIFEST +MMV.pm +MMV.xs +server.pl +test.pl +typemap diff --git a/src/perl/MMV/MMV.pm b/src/perl/MMV/MMV.pm new file mode 100644 index 0000000..9f3d7ea --- /dev/null +++ b/src/perl/MMV/MMV.pm @@ -0,0 +1,120 @@ +package PCP::MMV; + +use strict; +use warnings; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); + +require Exporter; +require DynaLoader; + +@ISA = qw(Exporter DynaLoader); +@EXPORT = qw( + mmv_stats_init mmv_stats_stop mmv_units + mmv_lookup_value_desc + mmv_inc_value mmv_set_value mmv_set_string + mmv_stats_add mmv_stats_inc mmv_stats_set + mmv_stats_add_fallback mmv_stats_inc_fallback + mmv_stats_interval_start mmv_stats_interval_end + mmv_stats_set_string + MMV_FLAG_NOPREFIX MMV_FLAG_PROCESS + MMV_INDOM_NULL + MMV_TYPE_NOSUPPORT + MMV_TYPE_I32 MMV_TYPE_U32 + MMV_TYPE_I64 MMV_TYPE_U64 + MMV_TYPE_FLOAT MMV_TYPE_DOUBLE + MMV_TYPE_STRING MMV_TYPE_ELAPSED + MMV_COUNT_ONE + MMV_SEM_COUNTER MMV_SEM_INSTANT MMV_SEM_DISCRETE + MMV_SPACE_BYTE MMV_SPACE_KBYTE MMV_SPACE_MBYTE + MMV_SPACE_GBYTE MMV_SPACE_TBYTE + MMV_TIME_NSEC MMV_TIME_USEC MMV_TIME_MSEC + MMV_TIME_SEC MMV_TIME_MIN MMV_TIME_HOUR +); +@EXPORT_OK = qw(); +$VERSION = '1.00'; + +sub MMV_INDOM_NULL { 0xffffffff; } + +# flags for pmdammv +sub MMV_FLAG_NOPREFIX { 0x1; } # metric names not prefixed by file name +sub MMV_FLAG_PROCESS { 0x2; } # instrumented process must be running + +# data type of metric values +sub MMV_TYPE_NOSUPPORT { 0xffffffff; } # not implemented in this version +sub MMV_TYPE_I32 { 0; } # 32-bit signed integer +sub MMV_TYPE_U32 { 1; } # 32-bit unsigned integer +sub MMV_TYPE_I64 { 2; } # 64-bit signed integer +sub MMV_TYPE_U64 { 3; } # 64-bit signed integer +sub MMV_TYPE_FLOAT { 4; } # 32-bit floating point +sub MMV_TYPE_DOUBLE { 5; } # 64-bit floating point +sub MMV_TYPE_STRING { 6; } # null-terminated string +sub MMV_TYPE_ELAPSED { 10; } # 64-bit elapsed time + +# units - space scale +sub MMV_SPACE_BYTE { 0; } # bytes +sub MMV_SPACE_KBYTE { 1; } # kilobytes +sub MMV_SPACE_MBYTE { 2; } # megabytes +sub MMV_SPACE_GBYTE { 3; } # gigabytes +sub MMV_SPACE_TBYTE { 4; } # terabytes + +# units - time scale +sub MMV_TIME_NSEC { 0; } # nanoseconds +sub MMV_TIME_USEC { 1; } # microseconds +sub MMV_TIME_MSEC { 2; } # milliseconds +sub MMV_TIME_SEC { 3; } # seconds +sub MMV_TIME_MIN { 4; } # minutes +sub MMV_TIME_HOUR { 5; } # hours + +# units - count scale (for metrics such as count events, syscalls, +# interrupts, etc - these are simply powers of ten and not enumerated here +# (e.g. 6 for 10^6, or -3 for 10^-3). +sub MMV_COUNT_ONE { 0; } # 1 + +# semantics/interpretation of metric values +sub MMV_SEM_COUNTER { 1; } # cumulative counter, monotonic increasing +sub MMV_SEM_INSTANT { 3; } # instantaneous value, continuous domain +sub MMV_SEM_DISCRETE { 4; } # instantaneous value, discrete domain + + +bootstrap PCP::MMV $VERSION; + +1; +__END__ + +=head1 NAME + +PCP::MMV - Perl module for Memory Mapped Value instrumentation + +=head1 SYNOPSIS + + use PCP::MMV; + +=head1 DESCRIPTION + +The PCP::MMV Perl module contains the language bindings for +building Perl programs instrumented with the Performance Co-Pilot +Memory Mapped Value infrastructure - an efficient data transport +mechanism for making performance data from within a Perl program +available as PCP metrics using the MMV PMDA. + +=head1 SEE ALSO + +mmv_stats_init(3), mmv_inc_value(3), mmv_lookup_value_desc(3), +mmv(4) and pmda(3). + +The PCP mailing list pcp@mail.performancecopilot.org can be used for +questions about this module. + +Further details can be found at http://www.performancecopilot.org + +=head1 AUTHOR + +Nathan Scott, E<lt>nathans@debian.orgE<gt> + +Copyright (C) 2009 by Aconex. + +This library is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License, version 2 (see +the "COPYING" file in the PCP source tree for further details). + +=cut diff --git a/src/perl/MMV/MMV.xs b/src/perl/MMV/MMV.xs new file mode 100644 index 0000000..2ee6ff8 --- /dev/null +++ b/src/perl/MMV/MMV.xs @@ -0,0 +1,381 @@ +/* + * Copyright (c) 2009 Aconex. All Rights Reserved. + * + * This program is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License as published by the + * Free Software Foundation; either version 2 of the License, or (at your + * option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * for more details. + */ + +#include "pmapi.h" +#include "mmv_stats.h" +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +static int +list_to_metric(SV *list, mmv_metric_t *metric) +{ + int i, len; + SV **entry[8]; + AV *mlist = (AV *) SvRV(list); + + if (SvTYPE((SV *)mlist) != SVt_PVAV) { + warn("metric declaration is not an array reference"); + return -1; + } + len = av_len(mlist) + 1; + if (len < 6) { + warn("too few entries in metric array reference"); + return -1; + } + if (len > 8) { + warn("too many entries in metric array reference"); + return -1; + } + for (i = 0; i < len; i++) + entry[i] = av_fetch(mlist, i, 0); + + strncpy(metric->name, SvPV_nolen(*entry[0]), MMV_NAMEMAX); + metric->name[MMV_NAMEMAX-1] = '\0'; + metric->item = SvIV(*entry[1]); + metric->type = SvIV(*entry[2]); + metric->indom = SvIV(*entry[3]); + i = SvIV(*entry[4]); + memcpy(&metric->dimension, &i, sizeof(pmUnits)); + metric->semantics = SvIV(*entry[5]); + if (len > 6) + metric->shorttext = strdup(SvPV_nolen(*entry[6])); + else + metric->shorttext = NULL; + if (len > 7) + metric->helptext = strdup(SvPV_nolen(*entry[7])); + else + metric->helptext = NULL; + return 0; +} + +static int +list_to_instances(SV *list, mmv_instances_t **insts) +{ + mmv_instances_t *instances; + int i, len; + AV *inlist = (AV *) SvRV(list); + + if (SvTYPE((SV *)inlist) != SVt_PVAV) { + warn("instances declaration is not an array reference"); + return -1; + } + len = av_len(inlist) + 1; + if (len++ % 2) { + warn("odd number of entries in instance array reference"); + return -1; + } + + len /= 2; + instances = (mmv_instances_t *)calloc(len, sizeof(mmv_instances_t)); + if (instances == NULL) { + warn("insufficient memory for instance array"); + return -1; + } + for (i = 0; i < len; i++) { + SV **id = av_fetch(inlist, i*2, 0); + SV **name = av_fetch(inlist, i*2+1, 0); + instances[i].internal = SvIV(*id); + strncpy(instances[i].external, SvPV_nolen(*name), MMV_NAMEMAX); + instances[i].external[MMV_NAMEMAX-1] = '\0'; + } + *insts = instances; + return len; +} + +static int +list_to_indom(SV *list, mmv_indom_t *indom) +{ + int i, len; + SV **entry[4]; + AV *ilist = (AV *) SvRV(list); + + if (SvTYPE((SV *)ilist) != SVt_PVAV) { + warn("indom declaration is not an array reference"); + return -1; + } + len = av_len(ilist) + 1; + if (len < 2) { + warn("too few entries in indom array reference"); + return -1; + } + if (len > 4) { + warn("too many entries in indom array reference"); + return -1; + } + for (i = 0; i < len; i++) + entry[i] = av_fetch(ilist, i, 0); + + indom->serial = SvIV(*entry[0]); + if ((i = list_to_instances(*entry[1], &indom->instances)) < 0) + return -1; + indom->count = i; + if (len > 2) + indom->shorttext = strdup(SvPV_nolen(*entry[2])); + else + indom->shorttext = NULL; + if (len > 3) + indom->helptext = strdup(SvPV_nolen(*entry[3])); + else + indom->helptext = NULL; + return 0; +} + +static int +list_to_metrics(SV *list, mmv_metric_t **metriclist, int *mcount) +{ + mmv_metric_t *metrics; + int i, len; + AV *mlist = (AV *) SvRV(list); + + if (SvTYPE((SV *)mlist) != SVt_PVAV) { + warn("metrics list is not an array reference"); + return -1; + } + len = av_len(mlist) + 1; + metrics = (mmv_metric_t *)calloc(len, sizeof(mmv_metric_t)); + if (metrics == NULL) { + warn("insufficient memory for metrics array"); + return -1; + } + for (i = 0; i < len; i++) { + SV **entry = av_fetch(mlist, i, 0); + if (list_to_metric(*entry, &metrics[i]) < 0) + break; + } + *metriclist = metrics; + *mcount = len; + return (i == len); +} + +static int +list_to_indoms(SV *list, mmv_indom_t **indomlist, int *icount) +{ + mmv_indom_t *indoms; + int i, len; + AV *ilist = (AV *) SvRV(list); + + if (SvTYPE((SV *)ilist) != SVt_PVAV) { + warn("indoms list is not an array reference"); + return -1; + } + len = av_len(ilist) + 1; + indoms = (mmv_indom_t *)calloc(len, sizeof(mmv_indom_t)); + if (indoms == NULL) { + warn("insufficient memory for indoms array"); + return -1; + } + for (i = 0; i < len; i++) { + SV **entry = av_fetch(ilist, i, 0); + if (list_to_indom(*entry, &indoms[i]) < 0) + break; + } + *indomlist = indoms; + *icount = len; + return (i == len); +} + + +MODULE = PCP::MMV PACKAGE = PCP::MMV + +void * +mmv_stats_init(name,cl,fl,metrics,indoms) + char * name + int cl + int fl + SV * metrics + SV * indoms + PREINIT: + int i, j; + int mcount; + int icount; + mmv_metric_t * mlist; + mmv_indom_t * ilist; + CODE: + i = list_to_metrics(metrics, &mlist, &mcount); + j = list_to_indoms(indoms, &ilist, &icount); + + if (i <= 0 || j <= 0) { + warn("mmv_stats_init: bad list conversion: metrics=%d indoms=%d\n", i, j); + RETVAL = NULL; + } + else { + RETVAL = mmv_stats_init(name, cl, fl, mlist, mcount, ilist, icount); + if (RETVAL == NULL) + warn("mmv_stats_init failed: %s\n", osstrerror()); + } + + for (i = 0; i < icount; i++) { + if (ilist[i].shorttext) + free(ilist[i].shorttext); + if (ilist[i].helptext) + free(ilist[i].helptext); + free(ilist[i].instances); + } + if (ilist) + free(ilist); + for (i = 0; i < mcount; i++) { + if (mlist[i].shorttext) + free(mlist[i].shorttext); + if (mlist[i].helptext) + free(mlist[i].helptext); + } + if (mlist) + free(mlist); + + if (!RETVAL) + XSRETURN_UNDEF; + OUTPUT: + RETVAL + +void +mmv_stats_stop(handle,name) + void * handle + char * name + CODE: + mmv_stats_stop(handle, name); + +int +mmv_units(dim_space,dim_time,dim_count,scale_space,scale_time,scale_count) + unsigned int dim_space + unsigned int dim_time + unsigned int dim_count + unsigned int scale_space + unsigned int scale_time + unsigned int scale_count + PREINIT: + pmUnits units; + CODE: + units.pad = 0; + units.dimSpace = dim_space; units.scaleSpace = scale_space; + units.dimTime = dim_time; units.scaleTime = scale_time; + units.dimCount = dim_count; units.scaleCount = scale_count; + RETVAL = *(int *)(&units); + OUTPUT: + RETVAL + +pmAtomValue * +mmv_lookup_value_desc(handle,metric,instance) + void * handle + char * metric + char * instance + CODE: + RETVAL = mmv_lookup_value_desc(handle, metric, instance); + OUTPUT: + RETVAL + +void +mmv_inc_value(handle,atom,value) + void * handle + pmAtomValue * atom + double value + CODE: + mmv_inc_value(handle, atom, value); + +void +mmv_set_value(handle,atom,value) + void * handle + pmAtomValue * atom + double value + CODE: + mmv_set_value(handle, atom, value); + +void +mmv_set_string(handle,atom,string) + void * handle + pmAtomValue * atom + SV * string + PREINIT: + int length; + char * data; + CODE: + data = SvPV_nolen(string); + length = strlen(data); + mmv_set_string(handle, atom, data, length); + +void +mmv_stats_add(handle,metric,instance,count) + void * handle + char * metric + char * instance + double count + CODE: + mmv_stats_add(handle, metric, instance, count); + +void +mmv_stats_inc(handle,metric,instance) + void * handle + char * metric + char * instance + CODE: + mmv_stats_inc(handle, metric, instance); + +void +mmv_stats_set(handle,metric,instance, value) + void * handle + char * metric + char * instance + double value + CODE: + mmv_stats_set(handle, metric, instance, value); + +void +mmv_stats_add_fallback(handle,metric,instance,instance2,count) + void * handle + char * metric + char * instance + char * instance2 + double count + CODE: + mmv_stats_add_fallback(handle, metric, instance, instance2, count); + +void +mmv_stats_inc_fallback(handle,metric,instance,instance2) + void * handle + char * metric + char * instance + char * instance2 + CODE: + mmv_stats_inc_fallback(handle, metric, instance, instance2); + +void +mmv_stats_interval_start(handle,value,metric,instance) + void * handle + pmAtomValue * value + char * metric + char * instance + CODE: + mmv_stats_interval_start(handle, value, metric, instance); + +void +mmv_stats_interval_end(handle, value) + void * handle + pmAtomValue * value + CODE: + mmv_stats_interval_end(handle, value); + +void +mmv_stats_set_string(handle,metric,instance,string) + void * handle + char * metric + char * instance + SV * string + PREINIT: + int length; + char * data; + CODE: + data = SvPV_nolen(string); + length = strlen(data); + mmv_stats_set_strlen(handle, metric, instance, data, length); + diff --git a/src/perl/MMV/Makefile.PL b/src/perl/MMV/Makefile.PL new file mode 100644 index 0000000..6a85129 --- /dev/null +++ b/src/perl/MMV/Makefile.PL @@ -0,0 +1,49 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +my $ldfrom; +my $inc; +my $libs; +my $lddlflags; +my $cccdlflags; + +if ($ENV{TARGET_OS} eq "mingw") { + $ldfrom = "-L$ENV{PCP_TOPDIR}/src/libpcp/src -L$ENV{PCP_TOPDIR}/src/libpcp_mmv/src -L$ENV{PCP_DIR}\\local\\bin -lpcp_mmv -lpcp MMV.o"; + $inc = "-I$ENV{PCP_TOPDIR}/src/include/pcp -I/usr/include/pcp -I$ENV{PCP_DIR}\\include\\pcp -I$ENV{PCP_DIR}\\c\\include"; + $libs = ["-L$ENV{PCP_DIR}\\local\\bin", '-lpcp_mmv', '-lpcp']; +} +else { + $ldfrom = "MMV.o"; + $inc = "-I$ENV{PCP_TOPDIR}/src/include/pcp -I/usr/include/pcp"; + $libs = ["-L$ENV{PCP_TOPDIR}/src/libpcp_mmv/src -L$ENV{PCP_TOPDIR}/src/libpcp/src -lpcp_mmv -lpcp"]; +} +if ($ENV{TARGET_OS} eq "darwin") { + # standard ones, minus -arch ppc + $lddlflags = "-arch x86_64 -arch i386 -bundle -undefined dynamic_lookup"; +} +else { + $lddlflags = "-shared \$(OPTIMIZE) \$(LDFLAGS)"; +} +if ($ENV{TARGET_OS} eq "solaris") { + # for OpenSolaris Makefile ends up with -KPIC instead of -fPIC otherwise + $cccdlflags = "-fPIC" +} + +WriteMakefile( + NAME => 'PCP::MMV', + AUTHOR => 'Nathan Scott <nathans@debian.org>', + VERSION_FROM => 'MMV.pm', # finds $VERSION + ABSTRACT_FROM => 'MMV.pm', # retrieve abstract from module + C => ['MMV.c'], + OPTIMIZE => '-g', + XSPROTOARG => '-noprototypes', + OBJECT => 'MMV.o', + DEFINE => '-DPERLIO_NOT_STDIO=0 -DPCP_VERSION -DPCP_DEBUG', + LDFROM => $ldfrom, + LDDLFLAGS => $lddlflags, + CCCDLFLAGS => $cccdlflags, + INC => $inc, + LIBS => $libs, + CC => $ENV{"CC"}, + LD => $ENV{"CC"}, +); diff --git a/src/perl/MMV/server.pl b/src/perl/MMV/server.pl new file mode 100755 index 0000000..f62f440 --- /dev/null +++ b/src/perl/MMV/server.pl @@ -0,0 +1,101 @@ +#!/usr/bin/perl +# +# Example server application that demonstrates use of the +# Perl PCP MMV module for runtime instrumentation. +# + +use strict; +use warnings; +use PCP::MMV; +use Time::HiRes qw ( usleep ); + +my @db_instances = ( 0 => "tempdb", 1 => "datadb" ); + +my $db_indom = 1; +my @indoms = ( + [ $db_indom, \@db_instances, + 'Database instances', + 'An instance domain for each database used by this server.', + ], +); + +my @metrics = ( + [ 'response_time.requests', + 1, MMV_TYPE_U64, MMV_INDOM_NULL, + mmv_units(0,0,1,0,0,MMV_COUNT_ONE), MMV_SEM_COUNTER, + 'Number of server requests processed', '' + ], + [ 'response_time.total', + 2, MMV_TYPE_U64, MMV_INDOM_NULL, + mmv_units(0,0,1,0,0,MMV_COUNT_ONE), MMV_SEM_COUNTER, + 'Maximum observed response time in milliseconds', '' + ], + [ 'response_time.maximum', + 3, MMV_TYPE_DOUBLE, MMV_INDOM_NULL, + mmv_units(0,1,0,0,MMV_TIME_MSEC,0), MMV_SEM_INSTANT, + 'Maximum observed response time in milliseconds', '' + ], + [ 'version', + 4, MMV_TYPE_STRING, MMV_INDOM_NULL, + mmv_units(0,0,0,0,0,0), MMV_SEM_DISCRETE, + 'Version number of the server process', '' + ], + [ 'database.transactions.count', + 5, MMV_TYPE_U64, $db_indom, + mmv_units(0,0,1,0,0,MMV_COUNT_ONE), MMV_SEM_COUNTER, + 'Number of requests issued to each database', '' + ], + [ 'database.transactions.time', + 6, MMV_TYPE_U64, $db_indom, + mmv_units(0,1,0,0,MMV_TIME_MSEC,0), MMV_SEM_COUNTER, + 'Total time spent waiting for results from each database', '' + ], + [ 'idletime', + 7, MMV_TYPE_U64, MMV_INDOM_NULL, + mmv_units(0,1,0,0,MMV_TIME_USEC,0), MMV_SEM_COUNTER, + 'Total time spent asleep, in-between requests', '' + ], +); + +my $handle = mmv_stats_init('server', 0, MMV_FLAG_PROCESS, \@metrics, \@indoms); +die("mmv_stats_init failed\n") unless (defined($handle)); + +mmv_stats_set_string($handle, 'version', '', '7.4.2-5'); + +my $maxtime = 0.0; # milliseconds + +for (;;) { + + my $idletime = 0.0; # microseconds + my $dbtime = 0.0; # milliseconds + my $response = 0.0; + + + # start a request ... + + $dbtime = rand 1000; # milliseconds + $response += $dbtime; + mmv_stats_inc($handle, 'database.transactions.count', 'tempdb'); + mmv_stats_add($handle, 'database.transactions.time', 'tempdb', $dbtime); + + # ... more work, involving a second DB request ... + $dbtime = rand 1000; # milliseconds + $response += $dbtime; + mmv_stats_inc($handle, 'database.transactions.count', 'datadb'); + mmv_stats_add($handle, 'database.transactions.time', 'datadb', $dbtime); + + # ... request completed + + + $response += rand 42; # milliseconds + mmv_stats_inc($handle, 'response_time.requests', ''); + mmv_stats_add($handle, 'response_time.total', '', $response); + if ($response > $maxtime) { + $maxtime = $response; + mmv_stats_set($handle, 'response_time.maximum', '', $maxtime); + } + + $idletime = rand 50000; # microseconds + usleep($idletime); + mmv_stats_add($handle, 'idletime', '', $idletime); +} diff --git a/src/perl/MMV/test.pl b/src/perl/MMV/test.pl new file mode 100644 index 0000000..15bd1c6 --- /dev/null +++ b/src/perl/MMV/test.pl @@ -0,0 +1,25 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' +# +# Copyright (c) 2009 Aconex. All Rights Reserved. +# +# This program is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation; either version 2 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# + +######################### We start with some black magic to print on failure. + +BEGIN { $| = 1; print "1..4\n"; } +END {print "not ok 1\n" unless $loaded;} +use PCP::MMV; +$loaded = 1; +print "ok 1\n"; + +######################### End of black magic. diff --git a/src/perl/MMV/typemap b/src/perl/MMV/typemap new file mode 100644 index 0000000..85f8812 --- /dev/null +++ b/src/perl/MMV/typemap @@ -0,0 +1,10 @@ +###################################################################### +# INPUT/OUTPUT maps +# O_OBJECT -> links an opaque C object to a blessed Perl object. +# +TYPEMAP +pmAtomValue * T_PTROBJ +mmv_indom_t * T_PTROBJ +mmv_metric_t * T_PTROBJ + +###################################################################### diff --git a/src/perl/PMDA/Changes b/src/perl/PMDA/Changes new file mode 100644 index 0000000..0f49bd5 --- /dev/null +++ b/src/perl/PMDA/Changes @@ -0,0 +1,101 @@ +Revision history for Perl extension PCP::PMDA. + +1.15 Thu Sep 5 11:22:34 EST 2013 + - Fix a subtle reference counting problem in the hash + indom code. + - Consistently use unsigned type to index the indom + table. + +1.14 Tue Jul 10 11:40:14 EST 2012 + - Add support for hash-based indom handling via PMDA + cache interfaces in libpcp_pmda. This introduces a + routine for looking up opaque PMDA data from instid + (pmda_inst_lookup) suitable for fetch callback use. + - Fix pmda_inst_name interface used by dtsrun PMDA - + using an incorrect value for indom lookup. This is + now consistent with the other instance interfaces, + and dtsrun PMDA (not widely used) has been fixed. + - Fix instance interface arguments - no current PMDA + makes use of this, but if one did (pmdaoracle will) + it would be given the internal indom identifier and + not the handle given to all other indom interfaces. + - Remove unused parameters to internal preinstance() + and prefetch() routines, no visible effect for any + PMDAs but the wrapper code becomes more readable. + - Fix help file handling which (for current gcc/perl + combinations at least) was using potentially-freed + memory. + +1.13 Thu Oct 20 11:50:18 EST 2011 + - Add an interface to allow a PMDA to drop privileges. + - Fix pmda_long and pmda_ulong 32-bit detection. + +1.12 Fri Jul 22 11:15:41 EST 2011 + - Ensure local fetch and instance wrapper routines + are always called. Otherwise refresh interface + doesn't work, and pmns_refresh may not be called + in all situations where it should be. + +1.11 Wed May 11 21:04:09 EST 2011 + - Make file tail non-blocking so it can be used for + named pipes as well as regular files. + +1.10 Thu Nov 25 03:30:18 EST 2010 + - Convert to using dynamic namespace interfaces. + - Added metric and indom table clearing interfaces. + +1.09 Sun Aug 1 09:04:38 EST 2010 + - Fix memory leak in fetch routine string handling. + +1.08 Thu Nov 19 10:37:26 EST 2009 + - Fix typo on name export for pmda_inst_name. + - Add a fast path lookup in pmda_inst_name for direct + instance identifier to offset case (common). + - When tailing logfiles, seek to end initially so we + don't spend potentially copious amounts of time on + scanning the entire log file - we only want events + that happen after PMDA startup to be counted too. + +1.07 Fri Aug 21 09:27:51 EST 2009 + - Add helper routines to determine native long sizes. + +1.06 Wed Jul 22 12:49:43 EST 2009 + - Ensure the process runs in its own process group, + and block SIGTERM in atexit handler. This resolves + a regression in the 1.05 fix for reaping children. + +1.05 Tue Jul 8 16:19:49 EST 2009 + - Explicitly free all local temporaries immediately + for routines that call Perl from C (fixes memleak). + - Fix an off-by-one when handling long input lines. + - Terminate any children started by the PMDA at exit. + +1.04 Mon Jul 6 11:08:20 EST 2009 + - Rewrote PMNS file generation to use libpcp routines. + +1.03 Wed Jun 10 14:53:05 EST 2009 + - Incorporated Win32 build changes (paths, etc). + - Remove (unneeded) use of hsearch and <search.h>. + +1.02 Tue Jun 2 17:16:25 EST 2009 + - Implemented log file rotation and host reconnect handling. + - Generally improved the file "tail" mode of operation. + +1.01 Fri Feb 13 17:33:31 EST 2009 + - Added simple instance name lookup routine. + +1.00 Thu Aug 20 08:48:14 EST 2008 + - Added several API components, 1st stable version. + +0.04 Mon Feb 25 15:01:33 EST 2008 + - Smaller, but still incompatible, API refinements. + +0.03 Sun Feb 24 09:06:39 EST 2008 + - API changes, moved existing Perl PMDAs out into PCP. + +0.02 Wed Feb 20 16:38:38 EST 2008 + - port forward to Perl API changes (circa Perl 5.6). + +0.01 Mon Sep 20 09:01:16 EST 1999 + - original version; created by h2xs 1.18 + diff --git a/src/perl/PMDA/GNUmakefile b/src/perl/PMDA/GNUmakefile new file mode 100644 index 0000000..98c6826 --- /dev/null +++ b/src/perl/PMDA/GNUmakefile @@ -0,0 +1,67 @@ +#!gmake +# +# Copyright (c) 2008-2010 Aconex. All Rights Reserved. +# Copyright (c) 2004 Silicon Graphics, Inc. All Rights Reserved. +# +# This program is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation; either version 2 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# + +TOPDIR = ../../.. +include $(TOPDIR)/src/include/builddefs + +PERLMOD = PMDA.pm +INTERFACE = PMDA.xs local.h local.c typemap +TESTCODE = test.pl cvalue.c +PERLDOCS = Changes MANIFEST +LSRCFILES = Makefile.PL $(PERLDOCS) $(PERLMOD) $(INTERFACE) $(TESTCODE) + +LPKGDIRT = PCP-PMDA-* MYMETA.yml MYMETA.json +LDIRT = Makefile COPYING PMDA.bs PMDA.c PMDA.o cvalue pm_to_blib blib \ + Makefile.old local.o $(LPKGDIRT) + +default: dist + +MAKEMAKER_OPTIONS = INSTALLDIRS=$(PERL_INSTALLDIRS) INSTALLVENDORMAN3DIR=$(PCP_MAN_DIR)/man3 +INSTALLER_OPTIONS = DESTDIR=$$DIST_ROOT + +ifeq ($(TARGET_OS),mingw) +PERLMAKE = dmake.exe +else +PERLMAKE = $(MAKE) +endif + +PMDA.o: Makefile PMDA.xs + $(PERLMAKE) -f Makefile + +Makefile: COPYING Makefile.PL + $(call PERL_MAKE_MAKEFILE) + +COPYING: + $(LN_S) $(TOPDIR)/COPYING COPYING + +test dist: PMDA.o + rm -rf $(LPKGDIRT) + $(PERLMAKE) -f Makefile $@ + +include $(BUILDRULES) + +install: default +ifneq "$(PACKAGE_DISTRIBUTION)" "debian" + $(call PERL_GET_FILELIST,$(TOPDIR)/perl-pcp-pmda.list,PMDA) +endif + +install_perl: + $(PERLMAKE) -f Makefile pure_install $(INSTALLER_OPTIONS) + +default_pcp: default + +install_pcp: install + diff --git a/src/perl/PMDA/MANIFEST b/src/perl/PMDA/MANIFEST new file mode 100644 index 0000000..b4749b6 --- /dev/null +++ b/src/perl/PMDA/MANIFEST @@ -0,0 +1,11 @@ +Changes +COPYING +cvalue.c +Makefile.PL +MANIFEST +PMDA.pm +PMDA.xs +local.h +local.c +test.pl +typemap diff --git a/src/perl/PMDA/Makefile.PL b/src/perl/PMDA/Makefile.PL new file mode 100644 index 0000000..1191a02 --- /dev/null +++ b/src/perl/PMDA/Makefile.PL @@ -0,0 +1,49 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +my $ldfrom; +my $inc; +my $libs; +my $lddlflags; +my $cccdlflags; + +if ($ENV{TARGET_OS} eq "mingw") { + $ldfrom = "-L$ENV{PCP_TOPDIR}/src/libpcp/src -L$ENV{PCP_TOPDIR}/src/libpcp_pmda/src -L$ENV{PCP_DIR}\\local\\bin -lpcp_pmda -lpcp local.o PMDA.o"; + $inc = "-I$ENV{PCP_TOPDIR}/src/include/pcp -I/usr/include/pcp -I$ENV{PCP_DIR}\\include\\pcp -I$ENV{PCP_DIR}\\c\\include"; + $libs = ["-L$ENV{PCP_DIR}\\local\\bin", '-lpcp_pmda', '-lpcp']; +} +else { + $ldfrom = "local.o PMDA.o"; + $inc = "-I$ENV{PCP_TOPDIR}/src/include/pcp -I/usr/include/pcp"; + $libs = ["-L$ENV{PCP_TOPDIR}/src/libpcp_pmda/src -L$ENV{PCP_TOPDIR}/src/libpcp/src -lpcp_pmda -lpcp"]; +} +if ($ENV{TARGET_OS} eq "darwin") { + # standard ones, minus -arch ppc + $lddlflags = "-arch x86_64 -arch i386 -bundle -undefined dynamic_lookup"; +} +else { + $lddlflags = "-shared \$(OPTIMIZE) \$(LDFLAGS)"; +} +if ($ENV{TARGET_OS} eq "solaris") { + # for OpenSolaris Makefile ends up with -KPIC instead of -fPIC otherwise + $cccdlflags = "-fPIC" +} + +WriteMakefile( + NAME => 'PCP::PMDA', + AUTHOR => 'Nathan Scott <nathans@debian.org>', + VERSION_FROM => 'PMDA.pm', # finds $VERSION + ABSTRACT_FROM => 'PMDA.pm', # retrieve abstract from module + C => ['local.c', 'PMDA.c'], + OPTIMIZE => '-g', + XSPROTOARG => '-noprototypes', + OBJECT => 'local.o PMDA.o', + DEFINE => '-DPERLIO_NOT_STDIO=0 -DPCP_VERSION -DPCP_DEBUG', + LDFROM => $ldfrom, + LDDLFLAGS => $lddlflags, + CCCDLFLAGS => $cccdlflags, + INC => $inc, + LIBS => $libs, + CC => $ENV{"CC"}, + LD => $ENV{"CC"}, +); diff --git a/src/perl/PMDA/PMDA.pm b/src/perl/PMDA/PMDA.pm new file mode 100644 index 0000000..d6b1a52 --- /dev/null +++ b/src/perl/PMDA/PMDA.pm @@ -0,0 +1,495 @@ +package PCP::PMDA; + +use strict; +use warnings; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); + +require Exporter; +require DynaLoader; + +@ISA = qw(Exporter DynaLoader); +@EXPORT = qw( + pmda_pmid pmda_pmid_name pmda_pmid_text pmda_inst_name pmda_inst_lookup + pmda_units pmda_config pmda_uptime pmda_long pmda_ulong + PM_ID_NULL PM_INDOM_NULL PM_IN_NULL + PM_SPACE_BYTE PM_SPACE_KBYTE PM_SPACE_MBYTE PM_SPACE_GBYTE PM_SPACE_TBYTE + PM_TIME_NSEC PM_TIME_USEC PM_TIME_MSEC PM_TIME_SEC PM_TIME_MIN PM_TIME_HOUR + PM_COUNT_ONE + PM_TYPE_NOSUPPORT PM_TYPE_32 PM_TYPE_U32 PM_TYPE_64 PM_TYPE_U64 + PM_TYPE_FLOAT PM_TYPE_DOUBLE PM_TYPE_STRING + PM_SEM_COUNTER PM_SEM_INSTANT PM_SEM_DISCRETE + PM_ERR_GENERIC PM_ERR_PMNS PM_ERR_NOPMNS PM_ERR_DUPPMNS PM_ERR_TEXT + PM_ERR_APPVERSION PM_ERR_VALUE PM_ERR_TIMEOUT + PM_ERR_NODATA PM_ERR_RESET PM_ERR_NAME PM_ERR_PMID + PM_ERR_INDOM PM_ERR_INST PM_ERR_UNIT PM_ERR_CONV PM_ERR_TRUNC + PM_ERR_SIGN PM_ERR_PROFILE PM_ERR_IPC PM_ERR_EOF + PM_ERR_NOTHOST PM_ERR_EOL PM_ERR_MODE PM_ERR_LABEL PM_ERR_LOGREC + PM_ERR_NOTARCHIVE PM_ERR_NOCONTEXT PM_ERR_PROFILESPEC PM_ERR_PMID_LOG + PM_ERR_INDOM_LOG PM_ERR_INST_LOG PM_ERR_NOPROFILE PM_ERR_NOAGENT + PM_ERR_PERMISSION PM_ERR_CONNLIMIT PM_ERR_AGAIN PM_ERR_ISCONN + PM_ERR_NOTCONN PM_ERR_NEEDPORT PM_ERR_NONLEAF + PM_ERR_PMDANOTREADY PM_ERR_PMDAREADY + PM_ERR_TOOSMALL PM_ERR_TOOBIG PM_ERR_NYI +); +@EXPORT_OK = qw(); +$VERSION = '1.15'; + +# metric identification +sub PM_ID_NULL { 0xffffffff; } +sub PM_INDOM_NULL { 0xffffffff; } +sub PM_IN_NULL { 0xffffffff; } + +# units - space scale +sub PM_SPACE_BYTE { 0; } # bytes +sub PM_SPACE_KBYTE { 1; } # kilobytes +sub PM_SPACE_MBYTE { 2; } # megabytes +sub PM_SPACE_GBYTE { 3; } # gigabytes +sub PM_SPACE_TBYTE { 4; } # terabytes +sub PM_SPACE_PBYTE { 5; } # petabytes +sub PM_SPACE_EBYTE { 6; } # exabytes + +# units - time scale +sub PM_TIME_NSEC { 0; } # nanoseconds +sub PM_TIME_USEC { 1; } # microseconds +sub PM_TIME_MSEC { 2; } # milliseconds +sub PM_TIME_SEC { 3; } # seconds +sub PM_TIME_MIN { 4; } # minutes +sub PM_TIME_HOUR { 5; } # hours + +# units - count scale (for metrics such as count events, syscalls, +# interrupts, etc - these are simply powers of ten and not enumerated here +# (e.g. 6 for 10^6, or -3 for 10^-3). +sub PM_COUNT_ONE { 0; } # 1 + +# data type of metric values +sub PM_TYPE_NOSUPPORT { 0xffffffff; } # not implemented in this version +sub PM_TYPE_32 { 0; } # 32-bit signed integer +sub PM_TYPE_U32 { 1; } # 32-bit unsigned integer +sub PM_TYPE_64 { 2; } # 64-bit signed integer +sub PM_TYPE_U64 { 3; } # 64-bit unsigned integer +sub PM_TYPE_FLOAT { 4; } # 32-bit floating point +sub PM_TYPE_DOUBLE { 5; } # 64-bit floating point +sub PM_TYPE_STRING { 6; } # array of characters +sub PM_TYPE_AGGREGATE { 7; } # arbitrary binary data (aggregate) +sub PM_TYPE_AGGREGATE_STATIC { 8; } # static pointer to aggregate +sub PM_TYPE_EVENT { 9; } # packed pmEventArray +sub PM_TYPE_UNKNOWN { 255; } + +# semantics/interpretation of metric values +sub PM_SEM_COUNTER { 1; } # cumulative counter (monotonic increasing) +sub PM_SEM_INSTANT { 3; } # instantaneous value, continuous domain +sub PM_SEM_DISCRETE { 4; } # instantaneous value, discrete domain + +# error codes +sub PM_ERR_GENERIC { -12345; } # Generic error, already reported above +sub PM_ERR_PMNS { -12346; } # Problems parsing PMNS definitions +sub PM_ERR_NOPMNS { -12347; } # PMNS not accessible +sub PM_ERR_DUPPMNS { -12348; } # Attempt to reload the PMNS +sub PM_ERR_TEXT { -12349; } # Oneline or help text is not available +sub PM_ERR_APPVERSION { -12350; } # Metric not supported by this version of monitored application +sub PM_ERR_VALUE { -12351; } # Missing metric value(s) +sub PM_ERR_TIMEOUT { -12353; } # Timeout waiting for a response from PMCD +sub PM_ERR_NODATA { -12354; } # Empty archive log file +sub PM_ERR_RESET { -12355; } # PMCD reset or configuration change +sub PM_ERR_NAME { -12357; } # Unknown metric name +sub PM_ERR_PMID { -12358; } # Unknown or illegal metric identifier +sub PM_ERR_INDOM { -12359; } # Unknown or illegal instance domain identifier +sub PM_ERR_INST { -12360; } # Unknown or illegal instance identifier +sub PM_ERR_UNIT { -12361; } # Illegal pmUnits specification +sub PM_ERR_CONV { -12362; } # Impossible value or scale conversion +sub PM_ERR_TRUNC { -12363; } # Truncation in value conversion +sub PM_ERR_SIGN { -12364; } # Negative value in conversion to unsigned +sub PM_ERR_PROFILE { -12365; } # Explicit instance identifier(s) required +sub PM_ERR_IPC { -12366; } # IPC protocol failure +sub PM_ERR_EOF { -12368; } # IPC channel closed +sub PM_ERR_NOTHOST { -12369; } # Operation requires context with host source of metrics +sub PM_ERR_EOL { -12370; } # End of PCP archive log +sub PM_ERR_MODE { -12371; } # Illegal mode specification +sub PM_ERR_LABEL { -12372; } # Illegal label record at start of a PCP archive log file +sub PM_ERR_LOGREC { -12373; } # Corrupted record in a PCP archive log +sub PM_ERR_NOTARCHIVE { -12374; } # Operation requires context with archive source of metrics +sub PM_ERR_NOCONTEXT { -12376; } # Attempt to use an illegal context +sub PM_ERR_PROFILESPEC { -12377; } # NULL pmInDom with non-NULL instlist +sub PM_ERR_PMID_LOG { -12378; } # Metric not defined in the PCP archive log +sub PM_ERR_INDOM_LOG { -12379; } # Instance domain identifier not defined in the PCP archive log +sub PM_ERR_INST_LOG { -12380; } # Instance identifier not defined in the PCP archive log +sub PM_ERR_NOPROFILE { -12381; } # Missing profile - protocol botch +sub PM_ERR_NOAGENT { -12386; } # No PMCD agent for domain of request +sub PM_ERR_PERMISSION { -12387; } # No permission to perform requested operation + +sub PM_ERR_CONNLIMIT { -12388; } # PMCD connection limit for this host exceeded +sub PM_ERR_AGAIN { -12389; } # Try again. Information not currently available +sub PM_ERR_ISCONN { -12390; } # Already Connected +sub PM_ERR_NOTCONN { -12391; } # Not Connected +sub PM_ERR_NEEDPORT { -12392; } # A non-null port name is required +sub PM_ERR_NONLEAF { -12394; } # Metric name is not a leaf in PMNS +sub PM_ERR_PMDANOTREADY { -13394; } # PMDA is not yet ready to respond to requests +sub PM_ERR_PMDAREADY { -13393; } # PMDA is now responsive to requests +sub PM_ERR_TOOSMALL { -12443; } # Insufficient elements in list +sub PM_ERR_TOOBIG { -12444; } # Result size exceeded +sub PM_ERR_NYI { -21344; } # Functionality not yet implemented + + +bootstrap PCP::PMDA $VERSION; + +1; +__END__ + +=head1 NAME + +PCP::PMDA - Perl extension for Performance Metrics Domain Agents + +=head1 SYNOPSIS + + use PCP::PMDA; + + $pmda = PCP::PMDA->new('myname', $MYDOMAIN); + + $pmda->connect_pmcd; + + $pmda->add_metric($pmid, $type, $indom, $sem, $units, 'name', '', ''); + $pmda->add_indom($indom, [0 => 'white', 1 => 'black', ...], '', ''); + + $pmda->set_fetch(\&fetch_method); + $pmda->set_refresh(\&refresh_method); + $pmda->set_instance(\&instance_method); + $pmda->set_fetch_callback(\&fetch_callback_method); + $pmda->set_store_callback(\&store_callback_method); + + $pmda->set_user('pcp'); + + $pmda->run; + +=head1 DESCRIPTION + +The PCP::PMDA Perl module contains the language bindings for +building Performance Metric Domain Agents (PMDAs) using Perl. +Each PMDA exports performance data for one specific domain, for +example the operating system kernel, Cisco routers, a database, +an application, etc. + +=head1 METHODS + +=over + +=item PCP::PMDA->new(name, domain) + +PCP::PMDA class constructor. I<name> is a string that becomes the +name of the PMDA for messages and default prefix for the names of +external files used by the PMDA. I<domain> is an integer domain +number for the PMDA, usually from the register of domain numbers +found in B<$PCP_VAR_DIR/pmns/stdpmid>. + +=item $pmda->run() + +Once all local setup is complete (i.e. instance domains and metrics +are registered, callbacks registered - as discussed below) the PMDA +must connect to B<pmcd>(1) to complete its initialisation and begin +answering client requests for its metrics. This is the role performed +by I<run>, and upon invoking it all interaction within the PMDA is +done via callback routines (that is to say, under normal cicrumstances, +the I<run> routine does not return). + +The behaviour of the I<run> method is different in the presence of +either the B<PCP_PERL_PMNS> or B<PCP_PERL_DOMAIN> environment variables. +These can be used to generate the namespace or domain number files, +which are used as part of the PMDA installation process. + +=item $pmda->connect_pmcd() + +Allows the PMDA to set up the IPC channel to B<pmcd>(1) and complete +the credentials handshake with B<pmcd>(1). If I<connect_pmcd> is not +explicitly called the setup and handshake will be done when the +I<run> method is called. + +The advantage of explicitly calling I<connect_pmcd> early in the life +of the PMDA is that this reduces the risk of a fatal timeout during +the credentials handshake, which may be an issue if the PMDA has +considerable work to do, e.g. determining which metrics and +instance domains are available, before calling I<run>. + +=item $pmda->add_indom(indom, insts, help, longhelp) + +Define a new instance domain. The instance domain identifier is +I<indom>, which is an integer and unique across all instance domains +for single PMDA. + +The instances of the instance domain are defined by I<insts> which +can be specified as either a list or a hash. + +In list form, the contents of the list must provide consecutive pairs +of identifier (a integer, unique across all instances in the instance +domain) and external instance name (a string, must by unique up to the +first space, if any, across all instances in the instance domain). +For example: + + @colours = [0 => 'red', 1 => 'green', 2 => 'blue']; + +In hash form, the external instance identifier (string) is used as the +hash key. An arbitrary value can be stored along with the key (this +value is often used as a convenient place to hold the latest value for +each metric instance, for example). + + %timeslices = ('sec' => 42, 'min' => \&min_func, 'hour' => '0'); + +The I<help> and I<longhelp> strings are interpreted as the one-line and +expanded help text to be used for this instance domain as further +described in B<pmLookupInDomText>(3). + +Refer also to the B<replace_indom>() discussion below for further details +about manipulating instance domains. + +=item $pmda->add_metric(pmid, type, indom, sem, units, name, help, longhelp) + +Define a new metric identified by the PMID I<pmid> and the full +metric name I<name>. + +The metric's metadata is defined by I<type>, I<indom>, I<sem> and +I<units> and these parameters are used to set up the I<pmDesc> +structure as described in B<pmLookupDesc>(3). + +The I<help> and I<longhelp> strings are interpreted as the one-line +and expanded help text to be used for the metric as further described +in B<pmLookupText>(3). + +=item $pmda->replace_indom(index, insts) + +Whenever an instance domain identified by I<index>, +previously registered using B<add_indom>(), +changes in any way, this change must be reflected by replacing the +existing mapping with a new one (I<insts>). + +The replacement mapping must be a hash if the instance domain +was registered initially with B<add_indom>() as a hash, otherwise it must be +a list. + +Refer to the earlier B<add_indom>() discussion concerning these two +different types of instance domains definitions. + +=item $pmda->add_pipe(command, callback, data) + +Allow data to be injected into the PMDA using a B<pipe>(2). + +The given I<command> is run early in the life of the PMDA, and a pipe +is formed between the PMDA and the I<command>. Line-oriented output +is assumed (else truncation will occur), and on receipt of each line +of text on the pipe, the I<callback> function will be called. + +The optional I<data> parameter can be used to specify extra data to +pass into the I<callback> routine. + +=item $pmda->add_sock(hostname, port, callback, data) + +Create a B<socket>(2) connection to the I<hostname>, I<port> pair. +Whenever data arrives (as above, a line-oriented protocol is best) +the I<callback> function will be called. + +The optional I<data> parameter can be used to specify extra data to +pass into the I<callback> routine. + +An opaque integer-sized identifier for the socket will be returned, +which can later be used in calls to B<put_sock>() as discussed below. + +=item $pmda->put_sock(id, output) + +Write an I<output> string to the socket identified by I<id>, which +must refer to a socket previously registered using B<add_sock>(). + +=item $pmda->add_tail(filename, callback, data) + +Monitor the given I<filename> for the arrival of newly appended +information. Line-oriented input is assumed (else truncation +will occur), and on receipt of each line of text on the pipe, +the I<callback> function will be called. + +The optional I<data> parameter can be used to specify extra data to +pass into the I<callback> routine. + +This interface deals with the issue of the file being renamed (such +as on daily log file rotation), and will attempt to automatically +re-route information from the new log file if this occurs. + +=item $pmda->add_timer(timeout, callback, data) + +Registers a timer with the PMDA, such that on expiry of a I<timeout> +a I<callback> routine will be called. This is a repeating timer. + +The optional I<data> parameter can be used to specify extra data to +pass into the I<callback> routine. + +=item $pmda->err(message) + +Report a timestamped error message into the PMDA log file. + +=item $pmda->error(message) + +Report a timestamped error message into the PMDA log file. + +=item $pmda->log(message) + +Report a timestamped informational message into the PMDA log file. + +=item $pmda->set_fetch_callback(cb_function) + +Register a callback function akin to B<pmdaSetFetchCallBack>(3). + +=item $pmda->set_fetch(function) + +Register a fetch function, as used by B<pmdaInit>(3). + +=item $pmda->set_instance(function) + +Register an instance function, as used by B<pmdaInit>(3). + +=item $pmda->set_refresh(function) + +Register a refresh function, which will be called once per metric +cluster, during the fetch operation. Only clusters being requested +during this fetch will be refreshed, allowing selective metric value +updates within the PMDA. + +=item $pmda->set_store_callback(cb_function) + +Register an store function, used indirectly by B<pmdaInit>(3). +The I<cb_function> is called once for each metric/instance pair +into which a B<pmStore>(3) is performed. + +=item $pmda->set_inet_socket(port) + +Specify the IPv4 socket I<port> to be used to communicate with B<pmcd>(1). + +=item $pmda->set_ipv6_socket(port) + +Specify the IPv6 socket I<port> to be used to communicate with B<pmcd>(1). + +=item $pmda->set_unix_socket(socket_name) + +Specify the filesystem I<socket_name> path to be used for communication +with B<pmcd>(1). + +=item $pmda->set_user(username) + +Run the PMDA under the I<username> user account, instead of the +default (root) user. + +=back + +=head1 HELPER METHODS + +=over + +=item pmda_pmid(cluster, item) + +Construct a Performance Metric Identifier (PMID) from the domain +number (passed as an argument to the I<new> constructor), the +I<cluster> (an integer in the range 0 to 2^12-1) and the +I<item> (an integer in the range 0 to 2^10-1). + +Every performance metric exported from a PMDA must have a unique +PMID. + +=item pmda_pmid_name(cluster, item) + +Perform a reverse metric identifier to name lookup - given the metric +I<cluster> and I<item> numbers, returns the metric name string. + +=item pmda_pmid_text(cluster, item) + +Returns the one-line metric help text string - given the metric +I<cluster> and I<item> numbers, returns the help text string. + +=item pmda_inst_name(index, instance) + +Perform a reverse instance identifier to instance name lookup +for the instance domain identified by I<index>. +Given the +internal I<instance> identifier, returns the external instance name string. + +=item pmda_inst_lookup(index, instance) + +Given an internal I<instance> identifier (key) for the +instance domain identified by I<index> with an associated indom hash, +return the value associated with that key. +The value can be any scalar value (this includes references, of course, +so complex data structures can be referenced). + +=item pmda_units(dim_space, dim_time, dim_count, scale_space, scale_time, scale_count) + +Construct a B<pmUnits> structure suitable for registering a metrics metadata +via B<add_metric>(). + +=item pmda_config(name) + +Lookup the value for configuration variable I<name> from the +I</etc/pcp.conf> file, +using B<pmGetConfig>(3). + +=item pmda_uptime(now) + +Return a human-readable uptime string, based on I<now> seconds since the epoch. + +=item pmda_long() + +Return either PM_TYPE_32 or PM_TYPE_64 depending on the platform size for a +signed long integer. + +=item pmda_ulong() + +Return either PM_TYPE_U32 or PM_TYPE_U64 depending on the platform size for an +unsigned long integer. + +=back + +=head1 MACROS + +Most of the PM_* macros from the PCP C headers are available. + +For example the I<type> of a metric's value may be directly +specified as one of +B<PM_TYPE_32>, B<PM_TYPE_U32>, B<PM_TYPE_64>, B<PM_TYPE_U64>, +B<PM_TYPE_FLOAT>, B<PM_TYPE_DOUBLE>, B<PM_TYPE_STRING> or +B<PM_TYPE_NOSUPPORT>. + +=head1 DEBUGGING + +Perl PMDAs do not follow the B<-D> convention of other PCP applications +for enabling run-time diagnostics and tracing. Rather the environment +variable B<PCP_PERL_DEBUG> needs to be set to a string value matching +the syntax accepted for the option value for B<-D> elsewhere, see +B<__pmParseDebug>(3). + +This requires a little trickery. The B<pmcd>(1) configuration file +(B<PCP_PMCDCONF_PATH> from I</etc/pcp.conf>) needs hand editing. +This is best demonstrated by example. + +Replace this line + + foo 242 pipe binary python /somepath/foo.py + +with + + foo 242 pipe binary python \ + sh -c "PCP_PERL_DEBUG=pdu,fetch /usr/bin/python /somepath/foo.py" + +=head1 SEE ALSO + +perl(1) and PCPIntro(1). + +The PCP mailing list pcp@mail.performancecopilot.org can be used for +questions about this module. + +Further details can be found at http://www.performancecopilot.org/ + +=head1 AUTHOR + +The Performance Co-Pilot development team. + +Copyright (C) 2014 Red Hat. +Copyright (C) 2008-2010 Aconex. +Copyright (C) 2004 Silicon Graphics, Inc. + +This library is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License, version 2 (see +the "COPYING" file in the PCP source tree for further details). + +=cut diff --git a/src/perl/PMDA/PMDA.xs b/src/perl/PMDA/PMDA.xs new file mode 100644 index 0000000..a6d16b2 --- /dev/null +++ b/src/perl/PMDA/PMDA.xs @@ -0,0 +1,1212 @@ +/* + * Copyright (c) 2013-2014 Red Hat. + * Copyright (c) 2008-2012 Aconex. All Rights Reserved. + * Copyright (c) 2004 Silicon Graphics, Inc. All Rights Reserved. + * + * This program is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License as published by the + * Free Software Foundation; either version 2 of the License, or (at your + * option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * for more details. + */ + +#include "local.h" +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +static pmdaInterface dispatch; +static pmdaMetric *metrictab; +static int mtab_size; +static __pmnsTree *pmns; +static int need_refresh; +static pmdaIndom *indomtab; +static int itab_size; +static int *clustertab; +static int ctab_size; + +static HV *metric_names; +static HV *metric_oneline; +static HV *metric_helptext; +static HV *indom_helptext; +static HV *indom_oneline; + +static SV *fetch_func; +static SV *refresh_func; +static SV *instance_func; +static SV *store_cb_func; +static SV *fetch_cb_func; + +int +clustertab_lookup(int cluster) +{ + int i, found = 0; + + for (i = 0; i < ctab_size; i++) { + if (cluster == clustertab[i]) { + found = 1; + break; + } + } + return found; +} + +void +clustertab_replace(int index, int cluster) +{ + if (index >= 0 && index < ctab_size) + clustertab[index] = cluster; + else + warn("invalid cluster table replacement requested"); +} + +void +clustertab_scratch() +{ + memset(clustertab, -1, sizeof(int) * ctab_size); +} + +void +clustertab_refresh(int index) +{ + dSP; + ENTER; + SAVETMPS; + PUSHMARK(sp); + XPUSHs(sv_2mortal(newSVuv(clustertab[index]))); + PUTBACK; + + perl_call_sv(refresh_func, G_VOID); + + SPAGAIN; + PUTBACK; + FREETMPS; + LEAVE; +} + +void +refresh(int numpmid, pmID *pmidlist) +{ + int i, numclusters = 0; + __pmID_int *pmid; + + /* Create list of affected clusters from pmidlist + * Note: we overwrite the initial cluster array here, to avoid + * allocating memory. The initial array contains all possible + * clusters whereas we (possibly) construct a subset here. We + * do not touch ctab_size at all, however, which lets us reuse + * the preallocated array space on every fetch. + */ + clustertab_scratch(); + for (i = 0; i < numpmid; i++) { + pmid = (__pmID_int *) &pmidlist[i]; + if (clustertab_lookup(pmid->cluster) == 0) + clustertab_replace(numclusters++, pmid->cluster); + } + + /* For each unique cluster, call the cluster refresh method */ + for (i = 0; i < numclusters; i++) + clustertab_refresh(i); +} + +void +pmns_refresh(void) +{ + char *pmid, *next; + I32 idsize; + SV *metric; + int sts; + + if (pmns) + __pmFreePMNS(pmns); + + if ((sts = __pmNewPMNS(&pmns)) < 0) + croak("failed to create namespace root: %s", pmErrStr(sts)); + + hv_iterinit(metric_names); + while ((metric = hv_iternextsv(metric_names, &pmid, &idsize)) != NULL) { + unsigned int domain, cluster, item, id; + + domain = strtoul(pmid, &next, 10); + cluster = strtoul(next+1, &next, 10); + item = strtoul(next+1, &next, 10); + id = pmid_build(domain, cluster, item); + if ((sts = __pmAddPMNSNode(pmns, id, SvPV_nolen(metric))) < 0) + croak("failed to add metric %s(%s) to namespace: %s", + SvPV_nolen(metric), pmIDStr(id), pmErrStr(sts)); + } + + pmdaTreeRebuildHash(pmns, mtab_size); /* for reverse (pmid->name) lookups */ + need_refresh = 0; +} + +int +pmns_desc(pmID pmid, pmDesc *desc, pmdaExt *ep) +{ + if (need_refresh) + pmns_refresh(); + return pmdaDesc(pmid, desc, ep); +} + +int +pmns_pmid(const char *name, pmID *pmid, pmdaExt *pmda) +{ + if (need_refresh) + pmns_refresh(); + return pmdaTreePMID(pmns, name, pmid); +} + +int +pmns_name(pmID pmid, char ***nameset, pmdaExt *pmda) +{ + if (need_refresh) + pmns_refresh(); + return pmdaTreeName(pmns, pmid, nameset); +} + +int +pmns_children(const char *name, int traverse, char ***kids, int **sts, pmdaExt *pmda) +{ + if (need_refresh) + pmns_refresh(); + return pmdaTreeChildren(pmns, name, traverse, kids, sts); +} + +void +pmns_write(void) +{ + __pmnsNode *node; + char *pppenv = getenv("PCP_PERL_PMNS"); + int root = pppenv ? strcmp(pppenv, "root") == 0 : 0; + char *prefix = root ? "\t" : ""; + + pmns_refresh(); + + if (root) + printf("root {\n"); + for (node = pmns->root->first; node != NULL; node = node->next) + printf("%s%s\t%u:*:*\n", prefix, node->name, dispatch.domain); + if (root) + printf("}\n"); +} + +void +domain_write(void) +{ + char *p, name[512] = { 0 }; + int i, len = strlen(pmProgname); + + if (len >= sizeof(name) - 1) + len = sizeof(name) - 2; + p = pmProgname; + if (strncmp(pmProgname, "pmda", 4) == 0) + p += 4; + for (i = 0; i < len; i++) + name[i] = toupper(p[i]); + printf("#define %s %u\n", name, dispatch.domain); +} + +void +prefetch(void) +{ + dSP; + ENTER; + SAVETMPS; + PUSHMARK(sp); + PUTBACK; + + perl_call_sv(fetch_func, G_VOID|G_NOARGS); + + SPAGAIN; + PUTBACK; + FREETMPS; + LEAVE; +} + +int +fetch(int numpmid, pmID *pmidlist, pmResult **rp, pmdaExt *pmda) +{ + if (need_refresh) + pmns_refresh(); + if (fetch_func) + prefetch(); + if (refresh_func) + refresh(numpmid, pmidlist); + return pmdaFetch(numpmid, pmidlist, rp, pmda); +} + +int +instance_index(pmInDom indom) +{ + int i; + + for (i = 0; i < itab_size; i++) + if (indomtab[i].it_indom == indom) + return i; + return PM_INDOM_NULL; +} + +void +preinstance(pmInDom indom) +{ + dSP; + ENTER; + SAVETMPS; + PUSHMARK(sp); + XPUSHs(sv_2mortal(newSVuv(indom))); + PUTBACK; + + perl_call_sv(instance_func, G_VOID); + + SPAGAIN; + PUTBACK; + FREETMPS; + LEAVE; +} + +int +instance(pmInDom indom, int a, char *b, __pmInResult **rp, pmdaExt *pmda) +{ + if (need_refresh) + pmns_refresh(); + if (instance_func) + preinstance(instance_index(indom)); + return pmdaInstance(indom, a, b, rp, pmda); +} + +void +timer_callback(int afid, void *data) +{ + dSP; + ENTER; + SAVETMPS; + PUSHMARK(sp); + XPUSHs(sv_2mortal(newSViv(local_timer_get_cookie(afid)))); + PUTBACK; + + perl_call_sv(local_timer_get_callback(afid), G_VOID); + + SPAGAIN; + PUTBACK; + FREETMPS; + LEAVE; +} + +void +input_callback(SV *input_cb_func, int data, char *string) +{ + dSP; + ENTER; + SAVETMPS; + PUSHMARK(sp); + XPUSHs(sv_2mortal(newSViv(data))); + XPUSHs(sv_2mortal(newSVpv(string,0))); + PUTBACK; + + perl_call_sv(input_cb_func, G_VOID); + + SPAGAIN; + PUTBACK; + FREETMPS; + LEAVE; +} + +int +fetch_callback(pmdaMetric *metric, unsigned int inst, pmAtomValue *atom) +{ + dSP; + __pmID_int *pmid; + int sts; + STRLEN n_a; /* required by older Perl versions, used in POPpx */ + + ENTER; + SAVETMPS; /* allows us to tidy our perl stack changes later */ + + (void)n_a; + pmid = (__pmID_int *) &metric->m_desc.pmid; + + PUSHMARK(sp); + XPUSHs(sv_2mortal(newSVuv(pmid->cluster))); + XPUSHs(sv_2mortal(newSVuv(pmid->item))); + XPUSHs(sv_2mortal(newSVuv(inst))); + PUTBACK; + + sts = perl_call_sv(fetch_cb_func, G_ARRAY); + SPAGAIN; /* refresh local perl stack pointer after call */ + if (sts != 2) { + croak("fetch CB error (returned %d values, expected 2)", sts); + sts = -EINVAL; + goto fetch_end; + } + sts = POPi; /* pop function return status */ + if (sts < 0) { + goto fetch_end; + } + else if (sts == 0) { + sts = POPi; + goto fetch_end; + } + + sts = PMDA_FETCH_STATIC; + switch (metric->m_desc.type) { /* pop result value */ + case PM_TYPE_32: atom->l = POPi; break; + case PM_TYPE_U32: atom->ul = POPi; break; + case PM_TYPE_64: atom->ll = POPl; break; + case PM_TYPE_U64: atom->ull = POPl; break; + case PM_TYPE_FLOAT: atom->f = POPn; break; + case PM_TYPE_DOUBLE: atom->d = POPn; break; + case PM_TYPE_STRING: { + atom->cp = strdup(POPpx); + sts = PMDA_FETCH_DYNAMIC; + break; + } + } + +fetch_end: + PUTBACK; + FREETMPS; + LEAVE; /* fix up the perl stack, freeing anything we created */ + return sts; +} + +int +store_callback(__pmID_int *pmid, unsigned int inst, pmAtomValue av, int type) +{ + dSP; + int sts; + ENTER; + SAVETMPS; + PUSHMARK(sp); + XPUSHs(sv_2mortal(newSVuv(pmid->cluster))); + XPUSHs(sv_2mortal(newSVuv(pmid->item))); + XPUSHs(sv_2mortal(newSVuv(inst))); + switch (type) { + case PM_TYPE_32: XPUSHs(sv_2mortal(newSViv(av.l))); break; + case PM_TYPE_U32: XPUSHs(sv_2mortal(newSVuv(av.ul))); break; + case PM_TYPE_64: XPUSHs(sv_2mortal(newSVuv(av.ll))); break; + case PM_TYPE_U64: XPUSHs(sv_2mortal(newSVuv(av.ull))); break; + case PM_TYPE_FLOAT: XPUSHs(sv_2mortal(newSVnv(av.f))); break; + case PM_TYPE_DOUBLE: XPUSHs(sv_2mortal(newSVnv(av.d))); break; + case PM_TYPE_STRING: XPUSHs(sv_2mortal(newSVpv(av.cp,0)));break; + } + PUTBACK; + + sts = perl_call_sv(store_cb_func, G_SCALAR); + SPAGAIN; /* refresh local perl stack pointer after call */ + if (sts != 1) { + croak("store CB error (returned %d values, expected 1)", sts); + sts = -EINVAL; + goto store_end; + } + sts = POPi; /* pop function return status */ + +store_end: + PUTBACK; + FREETMPS; + LEAVE; /* fix up the perl stack, freeing anything we created */ + return sts; +} + +int +store(pmResult *result, pmdaExt *pmda) +{ + int i, j; + int type; + int sts; + pmAtomValue av; + pmValueSet *vsp; + __pmID_int *pmid; + + if (need_refresh) + pmns_refresh(); + + for (i = 0; i < result->numpmid; i++) { + vsp = result->vset[i]; + pmid = (__pmID_int *)&vsp->pmid; + + /* need to find the type associated with this PMID */ + for (j = 0; j < mtab_size; j++) + if (metrictab[j].m_desc.pmid == *(pmID *)pmid) + break; + if (j == mtab_size) + return PM_ERR_PMID; + type = metrictab[j].m_desc.type; + + for (j = 0; j < vsp->numval; j++) { + sts = pmExtractValue(vsp->valfmt, &vsp->vlist[j],type, &av, type); + if (sts < 0) + return sts; + sts = store_callback(pmid, vsp->vlist[j].inst, av, type); + if (sts < 0) + return sts; + } + } + return 0; +} + +int +text(int ident, int type, char **buffer, pmdaExt *pmda) +{ + const char *hash; + int size; + SV **sv; + + if (need_refresh) + pmns_refresh(); + + if ((type & PM_TEXT_PMID) == PM_TEXT_PMID) { + hash = pmIDStr((pmID)ident); + size = strlen(hash); + if (type & PM_TEXT_ONELINE) + sv = hv_fetch(metric_oneline, hash, size, 0); + else + sv = hv_fetch(metric_helptext, hash, size, 0); + } + else { + hash = pmInDomStr((pmInDom)ident); + size = strlen(hash); + if (type & PM_TEXT_ONELINE) + sv = hv_fetch(indom_oneline, hash, size, 0); + else + sv = hv_fetch(indom_helptext, hash, size, 0); + } + + if (sv && (*sv)) + *buffer = SvPV_nolen(*sv); + return (*buffer == NULL) ? PM_ERR_TEXT : 0; +} + +/* + * Converts Perl hash ref like {'foo' => \&data, 'boo' => \&data} + * into an instance structure (indom). + */ +static int +update_hash_indom(SV *insts, pmInDom indom) +{ + int sts; + SV *data; + I32 instsize; + char *instance; + HV *ihash = (HV *) SvRV(insts); + + sts = pmdaCacheOp(indom, PMDA_CACHE_INACTIVE); + if (sts < 0) + warn("pmda cache inactivation failed: %s", pmErrStr(sts)); + + hv_iterinit(ihash); + while ((data = hv_iternextsv(ihash, &instance, &instsize)) != NULL) + pmdaCacheStore(indom, PMDA_CACHE_ADD, instance, SvREFCNT_inc(data)); + + sts = pmdaCacheOp(indom, PMDA_CACHE_SAVE); + if (sts < 0) + warn("pmda cache persistance failed: %s", pmErrStr(sts)); + + return 0; +} + +/* + * Free all memory associated with a Perl list based indom + */ +static void +release_list_indom(pmdaInstid *instances, int numinst) +{ + int i; + + if (instances && numinst > 0) { + for (i = 0; i < numinst; i++) + free(instances[i].i_name); /* update_list_indom strdup */ + free(instances); /* update_list_indom calloc */ + } +} + +/* + * Converts Perl list ref like [a => 'foo', b => 'boo'] into an indom. + */ +static int +update_list_indom(SV *insts, pmdaInstid **set) +{ + int i, len; + SV **id; + SV **name; + AV *ilist = (AV *) SvRV(insts); + pmdaInstid *instances; + + if ((len = av_len(ilist)) == -1) { /* empty */ + *set = NULL; + return 0; + } + if (len++ % 2 == 0) { + warn("invalid instance list (length must be a multiple of 2)"); + return -1; + } + + len /= 2; + instances = (pmdaInstid *) calloc(len, sizeof(pmdaInstid)); + if (instances == NULL) { + warn("insufficient memory for instance array"); + return -1; + } + for (i = 0; i < len; i++) { + id = av_fetch(ilist,i*2,0); + name = av_fetch(ilist,i*2+1,0); + instances[i].i_inst = SvIV(*id); + instances[i].i_name = strdup(SvPV_nolen(*name)); + if (instances[i].i_name == NULL) { + release_list_indom(instances, i); + warn("insufficient memory for instance array names"); + return -1; + } + } + *set = instances; + return len; +} + +/* + * Converts a Perl instance reference into a populated indom. + * This interface handles either the hash or list formats. + */ +static int +update_indom(SV *insts, pmInDom indom, pmdaInstid **set) +{ + SV *rv = (SV *) SvRV(insts); + pmdaInstid *instances; + + if (! SvROK(insts)) { + warn("expected a reference for instances argument"); + return -1; + } + if (SvTYPE(rv) == SVt_PVAV) + return update_list_indom(insts, set); + if (SvTYPE(rv) == SVt_PVHV) + return update_hash_indom(insts, indom); + warn("instance argument is neither an array nor hash reference"); + return -1; +} + + +MODULE = PCP::PMDA PACKAGE = PCP::PMDA + + +pmdaInterface * +new(CLASS,name,domain) + char * CLASS + char * name + int domain + PREINIT: + int sep; + char * p; + char * logfile; + char * pmdaname; + char helpfile[256]; + CODE: + pmProgname = name; + RETVAL = &dispatch; + logfile = local_strdup_suffix(name, ".log"); + pmdaname = local_strdup_prefix("pmda", name); + __pmSetProgname(pmdaname); + sep = __pmPathSeparator(); + if ((p = getenv("PCP_PERL_DEBUG")) != NULL) + if ((pmDebug = __pmParseDebug(p)) < 0) + pmDebug = 0; +#ifndef IS_MINGW + setsid(); +#endif + atexit(&local_atexit); + snprintf(helpfile, sizeof(helpfile), "%s%c%s%c" "help", + pmGetConfig("PCP_PMDAS_DIR"), sep, name, sep); + if (access(helpfile, R_OK) != 0) { + pmdaDaemon(&dispatch, PMDA_INTERFACE_5, pmdaname, domain, + logfile, NULL); + dispatch.version.four.text = text; + } + else { + pmdaDaemon(&dispatch, PMDA_INTERFACE_5, pmdaname, domain, + logfile, strdup(helpfile)); + } + dispatch.version.four.fetch = fetch; + dispatch.version.four.instance = instance; + dispatch.version.four.desc = pmns_desc; + dispatch.version.four.pmid = pmns_pmid; + dispatch.version.four.name = pmns_name; + dispatch.version.four.children = pmns_children; + + if (!getenv("PCP_PERL_PMNS") && !getenv("PCP_PERL_DOMAIN")) { + pmdaOpenLog(&dispatch); + } + metric_names = newHV(); + metric_oneline = newHV(); + metric_helptext = newHV(); + indom_helptext = newHV(); + indom_oneline = newHV(); + OUTPUT: + RETVAL + +int +pmda_pmid(cluster,item) + unsigned int cluster + unsigned int item + CODE: + RETVAL = pmid_build(dispatch.domain, cluster, item); + OUTPUT: + RETVAL + +SV * +pmda_pmid_name(cluster,item) + unsigned int cluster + unsigned int item + PREINIT: + const char *name; + SV **rval; + CODE: + name = pmIDStr(pmid_build(dispatch.domain, cluster, item)); + rval = hv_fetch(metric_names, name, strlen(name), 0); + if (!rval || !(*rval)) + XSRETURN_UNDEF; + RETVAL = newSVsv(*rval); + OUTPUT: + RETVAL + +SV * +pmda_pmid_text(cluster,item) + unsigned int cluster + unsigned int item + PREINIT: + const char *name; + SV **rval; + CODE: + name = pmIDStr(pmid_build(dispatch.domain, cluster, item)); + rval = hv_fetch(metric_oneline, name, strlen(name), 0); + if (!rval || !(*rval)) + XSRETURN_UNDEF; + RETVAL = newSVsv(*rval); + OUTPUT: + RETVAL + +SV * +pmda_inst_name(index,instance) + unsigned int index + int instance + PREINIT: + int i; + pmdaIndom * p; + pmdaInstid *instp; + CODE: + if (index >= itab_size) /* is this a valid indom */ + XSRETURN_UNDEF; + p = indomtab + index; + if (!p->it_set) /* was this indom previously setup via a hash? */ + XSRETURN_UNDEF; + + /* Optimistic (fast) direct lookup first, then iterate */ + i = instance; + if (i > p->it_numinst || i < 0 || instance != p->it_set[i].i_inst) { + for (i = 0; i < p->it_numinst; i++) + if (instance == p->it_set[i].i_inst) + break; + if (i == p->it_numinst) + XSRETURN_UNDEF; + } + RETVAL = newSVpv(p->it_set[i].i_name,0); + OUTPUT: + RETVAL + +SV * +pmda_inst_lookup(index,instance) + unsigned int index + int instance + PREINIT: + pmdaIndom * p; + SV * svp; + int i, sts; + CODE: + if (index >= itab_size) /* is this a valid indom */ + XSRETURN_UNDEF; + p = indomtab + index; + if (p->it_set) /* was this indom previously setup via an array? */ + XSRETURN_UNDEF; + sts = pmdaCacheLookup(p->it_indom, instance, NULL, (void *)&svp); + if (sts != PMDA_CACHE_ACTIVE) + XSRETURN_UNDEF; + RETVAL = SvREFCNT_inc(svp); + OUTPUT: + RETVAL + +int +pmda_units(dim_space,dim_time,dim_count,scale_space,scale_time,scale_count) + unsigned int dim_space + unsigned int dim_time + unsigned int dim_count + unsigned int scale_space + unsigned int scale_time + unsigned int scale_count + PREINIT: + pmUnits units; + CODE: + units.pad = 0; + units.dimSpace = dim_space; units.scaleSpace = scale_space; + units.dimTime = dim_time; units.scaleTime = scale_time; + units.dimCount = dim_count; units.scaleCount = scale_count; + RETVAL = *(int *)(&units); + OUTPUT: + RETVAL + +char * +pmda_config(name) + char * name + CODE: + RETVAL = pmGetConfig(name); + if (!RETVAL) + XSRETURN_UNDEF; + OUTPUT: + RETVAL + +char * +pmda_uptime(now) + int now + PREINIT: + static char s[32]; + size_t sz = sizeof(s); + int days, hours, mins, secs; + CODE: + days = now / (60 * 60 * 24); + now %= (60 * 60 * 24); + hours = now / (60 * 60); + now %= (60 * 60); + mins = now / 60; + now %= 60; + secs = now; + + if (days > 1) + snprintf(s, sz, "%ddays %02d:%02d:%02d", days, hours, mins, secs); + else if (days == 1) + snprintf(s, sz, "%dday %02d:%02d:%02d", days, hours, mins, secs); + else + snprintf(s, sz, "%02d:%02d:%02d", hours, mins, secs); + RETVAL = s; + OUTPUT: + RETVAL + +int +pmda_long() + CODE: + RETVAL = (sizeof(long) == 4) ? PM_TYPE_32 : PM_TYPE_64; + OUTPUT: + RETVAL + +int +pmda_ulong() + CODE: + RETVAL = (sizeof(unsigned long) == 4) ? PM_TYPE_32 : PM_TYPE_64; + OUTPUT: + RETVAL + + +void +error(self,message) + pmdaInterface *self + char * message + CODE: + __pmNotifyErr(LOG_ERR, "%s", message); + +int +set_user(self,username) + pmdaInterface *self + char * username + CODE: + RETVAL = __pmSetProcessIdentity(username); + OUTPUT: + RETVAL + +void +set_fetch(self,function) + pmdaInterface *self + SV * function + CODE: + if (function != (SV *)NULL) { + fetch_func = newSVsv(function); + } + +void +set_refresh(self,function) + pmdaInterface *self + SV * function + CODE: + if (function != (SV *)NULL) { + refresh_func = newSVsv(function); + } + +void +set_instance(self,function) + pmdaInterface *self + SV * function + CODE: + if (function != (SV *)NULL) { + instance_func = newSVsv(function); + } + +void +set_store_callback(self,cb_function) + pmdaInterface *self + SV * cb_function + CODE: + if (cb_function != (SV *)NULL) { + store_cb_func = newSVsv(cb_function); + self->version.four.store = store; + } + +void +set_fetch_callback(self,cb_function) + pmdaInterface *self + SV * cb_function + CODE: + if (cb_function != (SV *)NULL) { + fetch_cb_func = newSVsv(cb_function); + pmdaSetFetchCallBack(self, fetch_callback); + } + +void +set_inet_socket(self,port) + pmdaInterface *self + int port + CODE: + self->version.four.ext->e_io = pmdaInet; + self->version.four.ext->e_port = port; + +void +set_ipv6_socket(self,port) + pmdaInterface *self + int port + CODE: + self->version.four.ext->e_io = pmdaIPv6; + self->version.four.ext->e_port = port; + +void +set_unix_socket(self,socket_name) + pmdaInterface *self + char * socket_name + CODE: + self->version.four.ext->e_io = pmdaUnix; + self->version.four.ext->e_sockname = socket_name; + +void +clear_metrics(self) + pmdaInterface *self + CODE: + need_refresh = 1; + if (clustertab) + free(clustertab); + ctab_size = 0; + if (metrictab) + free(metrictab); + mtab_size = 0; + clearHV(metric_names); + clearHV(metric_oneline); + clearHV(metric_helptext); + +void +add_metric(self,pmid,type,indom,sem,units,name,help,longhelp) + pmdaInterface *self + int pmid + int type + int indom + int sem + int units + char * name + char * help + char * longhelp + PREINIT: + pmdaMetric * p; + __pmID_int * pmidp; + const char * hash; + int size; + CODE: + (void)self; + need_refresh = 1; + pmidp = (__pmID_int *)&pmid; + if (!clustertab_lookup(pmidp->cluster)) { + size = sizeof(int) * (ctab_size + 1); + clustertab = (int *)realloc(clustertab, size); + if (clustertab) + clustertab[ctab_size++] = pmidp->cluster; + else { + warn("unable to allocate memory for cluster table"); + ctab_size = 0; + XSRETURN_UNDEF; + } + } + + size = sizeof(pmdaMetric) * (mtab_size + 1); + metrictab = (pmdaMetric *)realloc(metrictab, size); + if (metrictab == NULL) { + warn("unable to allocate memory for metric table"); + mtab_size = 0; + XSRETURN_UNDEF; + } + + p = metrictab + mtab_size++; + p->m_user = NULL; p->m_desc.pmid = *(pmID *)&pmid; + p->m_desc.type = type; p->m_desc.indom = *(pmInDom *)&indom; + p->m_desc.sem = sem; p->m_desc.units = *(pmUnits *)&units; + + hash = pmIDStr(pmid); + size = strlen(hash); + hv_store(metric_names, hash, size, newSVpv(name,0), 0); + if (help) + hv_store(metric_oneline, hash, size, newSVpv(help,0), 0); + if (longhelp) + hv_store(metric_helptext, hash, size, newSVpv(longhelp,0), 0); + +void +clear_indoms(self) + pmdaInterface *self + CODE: + if (indomtab) + free(indomtab); + itab_size = 0; + if (metrictab) + free(metrictab); + mtab_size = 0; + clearHV(indom_oneline); + clearHV(indom_helptext); + +int +add_indom(self,indom,insts,help,longhelp) + pmdaInterface * self + int indom + SV * insts + char * help + char * longhelp + PREINIT: + pmdaIndom * p; + const char * hash; + int sts, size; + CODE: + size = sizeof(pmdaIndom) * (itab_size + 1); + indomtab = (pmdaIndom *)realloc(indomtab, size); + if (indomtab == NULL) { + warn("unable to allocate memory for indom table"); + itab_size = 0; + XSRETURN_UNDEF; + } + + p = indomtab + itab_size; + memset(p, 0, sizeof(pmdaIndom)); + p->it_indom = pmInDom_build(self->domain, indom); + + sts = update_indom(insts, p->it_indom, &p->it_set); + if (sts < 0) + XSRETURN_UNDEF; + if (p->it_set) + p->it_numinst = sts; + RETVAL = itab_size++; /* used in calls to replace_indom() */ + + hash = pmInDomStr(indom); + size = strlen(hash); + if (help) + hv_store(indom_oneline, hash, size, newSVpv(help,0), 0); + if (longhelp) + hv_store(indom_helptext, hash, size, newSVpv(longhelp,0), 0); + OUTPUT: + RETVAL + +int +replace_indom(self,index,insts) + pmdaInterface * self + unsigned int index + SV * insts + PREINIT: + pmdaIndom * p; + int sts; + CODE: + if (index >= itab_size) { + warn("attempt to replace non-existent instance domain"); + XSRETURN_UNDEF; + } + else { + p = indomtab + index; + /* was this indom previously setup via an array? */ + if (p->it_set) + release_list_indom(p->it_set, p->it_numinst); + sts = update_indom(insts, p->it_indom, &p->it_set); + if (sts < 0) + XSRETURN_UNDEF; + if (p->it_set) + p->it_numinst = sts; + RETVAL = sts; + } + OUTPUT: + RETVAL + +int +add_timer(self,timeout,callback,data) + pmdaInterface * self + double timeout + SV * callback + int data + CODE: + if (getenv("PCP_PERL_PMNS") || getenv("PCP_PERL_DOMAIN") || !callback) + XSRETURN_UNDEF; + RETVAL = local_timer(timeout, newSVsv(callback), data); + OUTPUT: + RETVAL + +int +add_pipe(self,command,callback,data) + pmdaInterface *self + char * command + SV * callback + int data + CODE: + if (getenv("PCP_PERL_PMNS") || getenv("PCP_PERL_DOMAIN") || !callback) + XSRETURN_UNDEF; + RETVAL = local_pipe(command, newSVsv(callback), data); + OUTPUT: + RETVAL + +int +add_tail(self,filename,callback,data) + pmdaInterface *self + char * filename + SV * callback + int data + CODE: + if (getenv("PCP_PERL_PMNS") || getenv("PCP_PERL_DOMAIN") || !callback) + XSRETURN_UNDEF; + RETVAL = local_tail(filename, newSVsv(callback), data); + OUTPUT: + RETVAL + +int +add_sock(self,hostname,port,callback,data) + pmdaInterface *self + char * hostname + int port + SV * callback + int data + CODE: + if (getenv("PCP_PERL_PMNS") || getenv("PCP_PERL_DOMAIN") || !callback) + XSRETURN_UNDEF; + RETVAL = local_sock(hostname, port, newSVsv(callback), data); + OUTPUT: + RETVAL + +int +put_sock(self,id,output) + pmdaInterface *self + int id + char * output + CODE: + size_t length = strlen(output); + RETVAL = __pmWrite(local_files_get_descriptor(id), output, length); + OUTPUT: + RETVAL + +void +log(self,message) + pmdaInterface *self + char * message + CODE: + __pmNotifyErr(LOG_INFO, "%s", message); + +void +err(self,message) + pmdaInterface *self + char * message + CODE: + __pmNotifyErr(LOG_ERR, "%s", message); + +void +connect_pmcd(self) + pmdaInterface *self + CODE: + /* + * Need to mimic the same special cases handled in run() + * that explicitly do NOT connect to pmcd and treat these + * as no-ops here + * + * Otherwise call pmdaConnet() to complete the PMDA's IPC + * channel setup and complete the connection handshake with + * pmcd. + */ + if (getenv("PCP_PERL_PMNS") != NULL) + ; + else if (getenv("PCP_PERL_DOMAIN") != NULL) + ; + else { + /* + * On success pmdaConnect sets PMDA_EXT_CONNECTED in e_flags ... + * this used in the guard below to stop run() calling + * pmdaConnect() again. + */ + pmdaConnect(self); + } + +void +run(self) + pmdaInterface *self + CODE: + if (getenv("PCP_PERL_PMNS") != NULL) + pmns_write(); /* generate ascii namespace */ + else if (getenv("PCP_PERL_DOMAIN") != NULL) + domain_write(); /* generate the domain header */ + else { /* or normal operating mode ... */ + pmns_refresh(); + pmdaInit(self, indomtab, itab_size, metrictab, mtab_size); + if ((self->version.any.ext->e_flags & PMDA_EXT_CONNECTED) != PMDA_EXT_CONNECTED) { + /* + * connect_pmcd() not called before, so need pmdaConnect() + * here before falling into the PDU-driven mainloop + */ + pmdaConnect(self); + } + local_pmdaMain(self); + } + +void +debug_metric(self) + pmdaInterface *self + PREINIT: + int i; + CODE: + /* NB: debugging only (used in test.pl to verify state) */ + fprintf(stderr, "metric table size = %d\n", mtab_size); + for (i = 0; i < mtab_size; i++) { + fprintf(stderr, "metric idx = %d\n\tpmid = %s\n\ttype = %u\n" + "\tindom= %d\n\tsem = %u\n\tunits= %u\n", + i, pmIDStr(metrictab[i].m_desc.pmid), metrictab[i].m_desc.type, + (int)metrictab[i].m_desc.indom, metrictab[i].m_desc.sem, + *(unsigned int *)&metrictab[i].m_desc.units); + } + (void)self; + +void +debug_indom(self) + pmdaInterface *self + PREINIT: + int i,j; + CODE: + /* NB: debugging only (used in test.pl to verify state) */ + fprintf(stderr, "indom table size = %d\n", itab_size); + for (i = 0; i < itab_size; i++) { + fprintf(stderr, "indom idx = %d\n\tindom = %d\n" + "\tninst = %u\n\tiptr = 0x%p\n", + i, *(int *)&indomtab[i].it_indom, indomtab[i].it_numinst, + indomtab[i].it_set); + for (j = 0; j < indomtab[i].it_numinst; j++) { + fprintf(stderr, "\t\tid=%d name=%s\n", + indomtab[i].it_set[j].i_inst, indomtab[i].it_set[j].i_name); + } + } + (void)self; + +void +debug_init(self) + pmdaInterface *self + CODE: + /* NB: debugging only (used in test.pl to verify state) */ + pmdaInit(self, indomtab, itab_size, metrictab, mtab_size); + diff --git a/src/perl/PMDA/cvalue.c b/src/perl/PMDA/cvalue.c new file mode 100644 index 0000000..fe9723c --- /dev/null +++ b/src/perl/PMDA/cvalue.c @@ -0,0 +1,155 @@ +/* + * Verifies that the information we see from PMDA.pm (perl) matches + * the local PCP installation (PMAPI) - used by test.pl: `make test` + * + * Copyright (c) 2004 Silicon Graphics, Inc. All Rights Reserved. + * + * This program is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License as published by the + * Free Software Foundation; either version 2 of the License, or (at your + * option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * for more details. + */ +#include <stdio.h> +#include <stdlib.h> +#include <values.h> +#include <pcp/pmapi.h> +#include <pcp/impl.h> +#include <pcp/pmda.h> + +void +ids(void) +{ + printf("PMDA_PMID: 0,0 = %d\n", PMDA_PMID(0,0)); + printf("PMDA_PMID: 1,1 = %d\n", PMDA_PMID(1,1)); + printf("PMDA_PMID: 27,13 = %d\n", PMDA_PMID(27,13)); + printf("PMDA_PMID: %d,0 = %d\n", MAXINT, PMDA_PMID(MAXINT,0)); + printf("PMDA_PMID: 0,%d = %d\n", MAXINT, PMDA_PMID(0,MAXINT)); + printf("PMDA_PMID: %d,%d = %d\n", MAXINT,MAXINT, PMDA_PMID(MAXINT,MAXINT)); +} + +void +units(void) +{ + pmUnits forw; + pmUnits back; + + forw.pad = back.pad = 0; + forw.dimSpace = back.scaleCount = 1; + forw.dimTime = back.scaleTime = 2; + forw.dimCount = back.scaleSpace = 3; + forw.scaleSpace = back.dimCount = 4; + forw.scaleTime = back.dimTime = 5; + forw.scaleCount = back.dimSpace = 6; + printf("pmUnits: 1,2,3,4,5,6 = %d\n", *(unsigned int *)&forw); + printf("pmUnits: 6,5,4,3,2,1 = %d\n", *(unsigned int *)&back); +} + +void +defines(void) +{ + printf("PM_ID_NULL=%u\n", PM_ID_NULL); + printf("PM_INDOM_NULL=%u\n", PM_INDOM_NULL); + printf("PM_IN_NULL=%u\n", PM_IN_NULL); + + printf("PM_SPACE_BYTE=%u\n", PM_SPACE_BYTE); + printf("PM_SPACE_KBYTE=%u\n", PM_SPACE_KBYTE); + printf("PM_SPACE_MBYTE=%u\n", PM_SPACE_MBYTE); + printf("PM_SPACE_GBYTE=%u\n", PM_SPACE_GBYTE); + printf("PM_SPACE_TBYTE=%u\n", PM_SPACE_TBYTE); + + printf("PM_TIME_NSEC=%u\n", PM_TIME_NSEC); + printf("PM_TIME_USEC=%u\n", PM_TIME_USEC); + printf("PM_TIME_MSEC=%u\n", PM_TIME_MSEC); + printf("PM_TIME_SEC=%u\n", PM_TIME_SEC); + printf("PM_TIME_MIN=%u\n", PM_TIME_MIN); + printf("PM_TIME_HOUR=%u\n", PM_TIME_HOUR); + + printf("PM_TYPE_NOSUPPORT=%u\n", PM_TYPE_NOSUPPORT); + printf("PM_TYPE_32=%u\n", PM_TYPE_32); + printf("PM_TYPE_U32=%u\n", PM_TYPE_U32); + printf("PM_TYPE_64=%u\n", PM_TYPE_64); + printf("PM_TYPE_U64=%u\n", PM_TYPE_U64); + printf("PM_TYPE_FLOAT=%u\n", PM_TYPE_FLOAT); + printf("PM_TYPE_DOUBLE=%u\n", PM_TYPE_DOUBLE); + printf("PM_TYPE_STRING=%u\n", PM_TYPE_STRING); + + printf("PM_SEM_COUNTER=%u\n", PM_SEM_COUNTER); + printf("PM_SEM_INSTANT=%u\n", PM_SEM_INSTANT); + printf("PM_SEM_DISCRETE=%u\n", PM_SEM_DISCRETE); + + printf("PM_ERR_GENERIC=%d\n", PM_ERR_GENERIC); + printf("PM_ERR_PMNS=%d\n", PM_ERR_PMNS); + printf("PM_ERR_NOPMNS=%d\n", PM_ERR_NOPMNS); + printf("PM_ERR_DUPPMNS=%d\n", PM_ERR_DUPPMNS); + printf("PM_ERR_TEXT=%d\n", PM_ERR_TEXT); + printf("PM_ERR_APPVERSION=%d\n", PM_ERR_APPVERSION); + printf("PM_ERR_VALUE=%d\n", PM_ERR_VALUE); + printf("PM_ERR_TIMEOUT=%d\n", PM_ERR_TIMEOUT); + printf("PM_ERR_NODATA=%d\n", PM_ERR_NODATA); + printf("PM_ERR_RESET=%d\n", PM_ERR_RESET); + printf("PM_ERR_NAME=%d\n", PM_ERR_NAME); + printf("PM_ERR_PMID=%d\n", PM_ERR_PMID); + printf("PM_ERR_INDOM=%d\n", PM_ERR_INDOM); + printf("PM_ERR_INST=%d\n", PM_ERR_INST); + printf("PM_ERR_UNIT=%d\n", PM_ERR_UNIT); + printf("PM_ERR_CONV=%d\n", PM_ERR_CONV); + printf("PM_ERR_TRUNC=%d\n", PM_ERR_TRUNC); + printf("PM_ERR_SIGN=%d\n", PM_ERR_SIGN); + printf("PM_ERR_PROFILE=%d\n", PM_ERR_PROFILE); + printf("PM_ERR_IPC=%d\n", PM_ERR_IPC); + printf("PM_ERR_EOF=%d\n", PM_ERR_EOF); + printf("PM_ERR_NOTHOST=%d\n", PM_ERR_NOTHOST); + printf("PM_ERR_EOL=%d\n", PM_ERR_EOL); + printf("PM_ERR_MODE=%d\n", PM_ERR_MODE); + printf("PM_ERR_LABEL=%d\n", PM_ERR_LABEL); + printf("PM_ERR_LOGREC=%d\n", PM_ERR_LOGREC); + printf("PM_ERR_NOTARCHIVE=%d\n", PM_ERR_NOTARCHIVE); + printf("PM_ERR_LOGFILE=%d\n", PM_ERR_LOGFILE); + printf("PM_ERR_NOCONTEXT=%d\n", PM_ERR_NOCONTEXT); + printf("PM_ERR_PROFILESPEC=%d\n", PM_ERR_PROFILESPEC); + printf("PM_ERR_PMID_LOG=%d\n", PM_ERR_PMID_LOG); + printf("PM_ERR_INDOM_LOG=%d\n", PM_ERR_INDOM_LOG); + printf("PM_ERR_INST_LOG=%d\n", PM_ERR_INST_LOG); + printf("PM_ERR_NOPROFILE=%d\n", PM_ERR_NOPROFILE); + printf("PM_ERR_NOAGENT=%d\n", PM_ERR_NOAGENT); + printf("PM_ERR_PERMISSION=%d\n", PM_ERR_PERMISSION); + printf("PM_ERR_CONNLIMIT=%d\n", PM_ERR_CONNLIMIT); + printf("PM_ERR_AGAIN=%d\n", PM_ERR_AGAIN); + printf("PM_ERR_ISCONN=%d\n", PM_ERR_ISCONN); + printf("PM_ERR_NOTCONN=%d\n", PM_ERR_NOTCONN); + printf("PM_ERR_NEEDPORT=%d\n", PM_ERR_NEEDPORT); + printf("PM_ERR_NONLEAF=%d\n", PM_ERR_NONLEAF); + printf("PM_ERR_TYPE=%d\n", PM_ERR_TYPE); + printf("PM_ERR_TOOSMALL=%d\n", PM_ERR_TOOSMALL); + printf("PM_ERR_TOOBIG=%d\n", PM_ERR_TOOBIG); + printf("PM_ERR_PMDAREADY=%d\n", PM_ERR_PMDAREADY); + printf("PM_ERR_PMDANOTREADY=%d\n", PM_ERR_PMDANOTREADY); + printf("PM_ERR_NYI=%d\n", PM_ERR_NYI); +} + +int +main(int argc, char **argv) +{ + char *use = "Error: must provide one argument - either 'd', 'i' or 'u'\n"; + if (argc != 2) { + fputs(use, stderr); + return 1; + } + else if (argv[1][0] == 'd') + defines(); + else if (argv[1][0] == 'i') + ids(); + else if (argv[1][0] == 'u') + units(); + else { + fputs(use, stderr); + fprintf(stderr, "(ouch!!!! that really hurt! who throws a '%s' anyway? --Austin)\n", argv[1]); + return 1; + } + return 0; +} diff --git a/src/perl/PMDA/local.c b/src/perl/PMDA/local.c new file mode 100644 index 0000000..03a67fa --- /dev/null +++ b/src/perl/PMDA/local.c @@ -0,0 +1,468 @@ +/* + * Copyright (c) 2012-2014 Red Hat. + * Copyright (c) 2008-2011 Aconex. All Rights Reserved. + * + * This program is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License as published by the + * Free Software Foundation; either version 2 of the License, or (at your + * option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * for more details. + */ + +#include "local.h" +#include <dirent.h> +#include <search.h> +#include <sys/stat.h> +#ifdef HAVE_PWD_H +#include <pwd.h> +#endif + +static timers_t *timers; +static int ntimers; +static files_t *files; +static int nfiles; + +char * +local_strdup_suffix(const char *string, const char *suffix) +{ + size_t length = strlen(string) + strlen(suffix) + 1; + char *result = malloc(length); + + if (!result) + return result; + sprintf(result, "%s%s", string, suffix); + return result; +} + +char * +local_strdup_prefix(const char *prefix, const char *string) +{ + size_t length = strlen(prefix) + strlen(string) + 1; + char *result = malloc(length); + + if (!result) + return result; + sprintf(result, "%s%s", prefix, string); + return result; +} + +int +local_timer(double timeout, scalar_t *callback, int cookie) +{ + int size = sizeof(*timers) * (ntimers + 1); + delta_t delta; + + delta.tv_sec = (time_t)timeout; + delta.tv_usec = (long)((timeout - (double)delta.tv_sec) * 1000000.0); + + if ((timers = realloc(timers, size)) == NULL) + __pmNoMem("timers resize", size, PM_FATAL_ERR); + timers[ntimers].id = -1; /* not yet registered */ + timers[ntimers].delta = delta; + timers[ntimers].cookie = cookie; + timers[ntimers].callback = callback; + return ntimers++; +} + +int +local_timer_get_cookie(int id) +{ + int i; + + for (i = 0; i < ntimers; i++) + if (timers[i].id == id) + return timers[i].cookie; + return -1; +} + +scalar_t * +local_timer_get_callback(int id) +{ + int i; + + for (i = 0; i < ntimers; i++) + if (timers[i].id == id) + return timers[i].callback; + return NULL; +} + +static int +local_file(int type, int fd, scalar_t *callback, int cookie) +{ + int size = sizeof(*files) * (nfiles + 1); + + if ((files = realloc(files, size)) == NULL) + __pmNoMem("files resize", size, PM_FATAL_ERR); + files[nfiles].type = type; + files[nfiles].fd = fd; + files[nfiles].cookie = cookie; + files[nfiles].callback = callback; + return nfiles++; +} + +int +local_pipe(char *pipe, scalar_t *callback, int cookie) +{ + FILE *fp = popen(pipe, "r"); + int me; + +#if defined(HAVE_SIGPIPE) + signal(SIGPIPE, SIG_IGN); +#endif + if (!fp) { + __pmNotifyErr(LOG_ERR, "popen failed (%s): %s", pipe, osstrerror()); + exit(1); + } + me = local_file(FILE_PIPE, fileno(fp), callback, cookie); + files[me].me.pipe.file = fp; + return fileno(fp); +} + +int +local_tail(char *file, scalar_t *callback, int cookie) +{ + int fd = open(file, O_RDONLY | O_NDELAY); + struct stat stats; + int me; + + if (fd < 0) { + __pmNotifyErr(LOG_ERR, "open failed (%s): %s", file, osstrerror()); + exit(1); + } + if (fstat(fd, &stats) < 0) { + __pmNotifyErr(LOG_ERR, "fstat failed (%s): %s", file, osstrerror()); + exit(1); + } + lseek(fd, 0L, SEEK_END); + me = local_file(FILE_TAIL, fd, callback, cookie); + files[me].me.tail.path = strdup(file); + files[me].me.tail.dev = stats.st_dev; + files[me].me.tail.ino = stats.st_ino; + return me; +} + +int +local_sock(char *host, int port, scalar_t *callback, int cookie) +{ + __pmSockAddr *myaddr; + __pmHostEnt *servinfo = NULL; + void *enumIx; + int sts = -1; + int me, fd = -1; + + if ((servinfo = __pmGetAddrInfo(host)) == NULL) { + __pmNotifyErr(LOG_ERR, "__pmGetAddrInfo (%s): %s", host, netstrerror()); + goto error; + } + /* Loop over the addresses resolved for this host name until one of them + connects. */ + enumIx = NULL; + for (myaddr = __pmHostEntGetSockAddr(servinfo, &enumIx); + myaddr != NULL; + myaddr = __pmHostEntGetSockAddr(servinfo, &enumIx)) { + if (__pmSockAddrIsInet(myaddr)) + fd = __pmCreateSocket(); + else if (__pmSockAddrIsIPv6(myaddr)) + fd = __pmCreateIPv6Socket(); + else { + __pmNotifyErr(LOG_ERR, "invalid address family: %d\n", + __pmSockAddrGetFamily(myaddr)); + fd = -1; + } + + if (fd < 0) { + __pmSockAddrFree(myaddr); + continue; /* Try the next address */ + } + + __pmSockAddrSetPort(myaddr, port); + + sts = __pmConnect(fd, (void *)myaddr, __pmSockAddrSize()); + __pmSockAddrFree(myaddr); + if (sts == 0) + break; /* Successful connection */ + + /* Try the next address */ + __pmCloseSocket(fd); + fd = -1; + } + __pmHostEntFree(servinfo); + + if (sts < 0) { + __pmNotifyErr(LOG_ERR, "__pmConnect (%s): %s", host, netstrerror()); + goto error; + } + + me = local_file(FILE_SOCK, fd, callback, cookie); + files[me].me.sock.host = strdup(host); + files[me].me.sock.port = port; + + return me; + + error: + if (fd >= 0) + __pmCloseSocket(fd); + if (servinfo) + __pmHostEntFree(servinfo); + exit(1); +} + +static char * +local_filetype(int type) +{ + if (type == FILE_SOCK) + return "socket connection"; + if (type == FILE_PIPE) + return "command pipe"; + if (type == FILE_TAIL) + return "tailed file"; + return NULL; +} + +int +local_files_get_descriptor(int id) +{ + if (id < 0 || id >= nfiles) + return -1; + return files[id].fd; +} + +void +local_atexit(void) +{ + while (ntimers > 0) { + --ntimers; + __pmAFunregister(timers[ntimers].id); + } + if (timers) { + free(timers); + timers = NULL; + } + while (nfiles > 0) { + --nfiles; + if (files[nfiles].type == FILE_PIPE) + pclose(files[nfiles].me.pipe.file); + if (files[nfiles].type == FILE_TAIL) { + close(files[nfiles].fd); + if (files[nfiles].me.tail.path) + free(files[nfiles].me.tail.path); + files[nfiles].me.tail.path = NULL; + } + if (files[nfiles].type == FILE_SOCK) { + __pmCloseSocket(files[nfiles].fd); + if (files[nfiles].me.sock.host) + free(files[nfiles].me.sock.host); + files[nfiles].me.sock.host = NULL; + } + } + if (files) { + free(files); + files = NULL; + } + /* take out any children we created */ +#ifdef HAVE_SIGNAL + signal(SIGTERM, SIG_IGN); +#endif + __pmProcessTerminate((pid_t)0, 0); +} + +static void +local_log_rotated(files_t *file) +{ + struct stat stats; + + if (stat(file->me.tail.path, &stats) < 0) + return; + if (stats.st_ino == file->me.tail.ino && stats.st_dev == file->me.tail.dev) + return; + + close(file->fd); + file->fd = open(file->me.tail.path, O_RDONLY | O_NDELAY); + if (file->fd < 0) { + __pmNotifyErr(LOG_ERR, "open failed after log rotate (%s): %s", + file->me.tail.path, osstrerror()); + return; + } + files->me.tail.dev = stats.st_dev; + files->me.tail.ino = stats.st_ino; +} + +static void +local_reconnector(files_t *file) +{ + __pmSockAddr *myaddr = NULL; + __pmHostEnt *servinfo = NULL; + int fd = -1; + int sts = -1; + void *enumIx; + + if (file->fd >= 0) /* reconnect-needed flag */ + goto done; + if ((servinfo = __pmGetAddrInfo(file->me.sock.host)) == NULL) + goto done; + /* Loop over the addresses resolved for this host name until one of them + connects. */ + enumIx = NULL; + for (myaddr = __pmHostEntGetSockAddr(servinfo, &enumIx); + myaddr != NULL; + myaddr = __pmHostEntGetSockAddr(servinfo, &enumIx)) { + if (__pmSockAddrIsInet(myaddr)) + fd = __pmCreateSocket(); + else if (__pmSockAddrIsIPv6(myaddr)) + fd = __pmCreateIPv6Socket(); + else { + __pmNotifyErr(LOG_ERR, "invalid address family: %d\n", + __pmSockAddrGetFamily(myaddr)); + fd = -1; + } + + if (fd < 0) { + __pmSockAddrFree(myaddr); + continue; /* Try the next address */ + } + + __pmSockAddrSetPort(myaddr, files->me.sock.port); + sts = __pmConnect(fd, (void *)myaddr, __pmSockAddrSize()); + __pmSockAddrFree(myaddr); + if (sts == 0) /* good connection */ + break; + + /* Try the next address */ + __pmCloseSocket(fd); + fd = -1; + } + + if (fd >= 0) + files->fd = fd; + +done: + if (myaddr) + __pmSockAddrFree(myaddr); + if (servinfo) + __pmHostEntFree(servinfo); +} + +static void +local_connection(files_t *file) +{ + if (file->type == FILE_TAIL) + local_log_rotated(file); + else if (file->type == FILE_TAIL) + local_reconnector(file); +} + +void +local_pmdaMain(pmdaInterface *self) +{ + static char buffer[4096]; + int pmcdfd, nready, nfds, i, j, count, fd, maxfd = -1; + __pmFdSet fds, readyfds; + ssize_t bytes; + size_t offset; + char *s, *p; + + if ((pmcdfd = __pmdaInFd(self)) < 0) + exit(1); + + for (i = 0; i < ntimers; i++) + timers[i].id = __pmAFregister(&timers[i].delta, &timers[i].cookie, + timer_callback); + + /* custom PMDA main loop */ + for (count = 0; ; count++) { + struct timeval timeout = { 1, 0 }; + + __pmFD_ZERO(&fds); + __pmFD_SET(pmcdfd, &fds); + for (i = 0; i < nfiles; i++) { + if (files[i].type == FILE_TAIL) + continue; + fd = files[i].fd; + __pmFD_SET(fd, &fds); + if (fd > maxfd) + maxfd = fd; + } + nfds = ((pmcdfd > maxfd) ? pmcdfd : maxfd) + 1; + + __pmFD_COPY(&readyfds, &fds); + nready = __pmSelectRead(nfds, &readyfds, &timeout); + if (nready < 0) { + if (neterror() != EINTR) { + __pmNotifyErr(LOG_ERR, "select failed: %s\n", + netstrerror()); + exit(1); + } + continue; + } + + __pmAFblock(); + + if (__pmFD_ISSET(pmcdfd, &readyfds)) { + if (__pmdaMainPDU(self) < 0) { + __pmAFunblock(); + exit(1); + } + } + + for (i = 0; i < nfiles; i++) { + fd = files[i].fd; + /* check for log rotation or host reconnection needed */ + if ((count % 10) == 0) /* but only once every 10 */ + local_connection(&files[i]); + if (files[i].type != FILE_TAIL && !(__pmFD_ISSET(fd, &readyfds))) + continue; + offset = 0; +multiread: + bytes = __pmRead(fd, buffer + offset, sizeof(buffer)-1 - offset); + if (bytes < 0) { + if ((files[i].type == FILE_TAIL) && + (oserror() == EINTR) || + (oserror() == EAGAIN) || + (oserror() == EWOULDBLOCK)) + continue; + if (files[i].type == FILE_SOCK) { + close(files[i].fd); + files[i].fd = -1; + continue; + } + __pmNotifyErr(LOG_ERR, "Data read error on %s: %s\n", + local_filetype(files[i].type), osstrerror()); + exit(1); + } + if (bytes == 0) { + if (files[i].type == FILE_TAIL) + continue; + __pmNotifyErr(LOG_ERR, "No data to read - %s may be closed\n", + local_filetype(files[i].type)); + exit(1); + } + buffer[sizeof(buffer)-1] = '\0'; + for (s = p = buffer, j = 0; + *s != '\0' && j < sizeof(buffer)-1; + s++, j++) { + if (*s != '\n') + continue; + *s = '\0'; + /*__pmNotifyErr(LOG_INFO, "Input callback: %s\n", p);*/ + input_callback(files[i].callback, files[i].cookie, p); + p = s + 1; + } + if (files[i].type == FILE_TAIL) { + /* did we just do a full buffer read? */ + if (p == buffer) { + __pmNotifyErr(LOG_ERR, "Ignoring long line: \"%s\"\n", p); + } else if (j == sizeof(buffer) - 1) { + offset = sizeof(buffer)-1 - (p - buffer); + memmove(buffer, p, offset); + goto multiread; /* read rest of line */ + } + } + } + + __pmAFunblock(); + } +} diff --git a/src/perl/PMDA/local.h b/src/perl/PMDA/local.h new file mode 100644 index 0000000..11812cd --- /dev/null +++ b/src/perl/PMDA/local.h @@ -0,0 +1,80 @@ +/* + * Copyright (c) 2008-2010 Aconex. All Rights Reserved. + * + * This program is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License as published by the + * Free Software Foundation; either version 2 of the License, or (at your + * option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * for more details. + */ +#ifndef LOCAL_H +#define LOCAL_H + +#include <pmapi.h> +#include <impl.h> +#include <pmda.h> + +typedef struct sv scalar_t; +typedef struct timeval delta_t; + +typedef struct { + int id; + delta_t delta; + int cookie; + scalar_t *callback; +} timers_t; + +typedef enum { FILE_PIPE, FILE_SOCK, FILE_TAIL } file_type_t; + +typedef struct { + FILE *file; +} pipe_data_t; + +typedef struct { + char *path; + dev_t dev; + ino_t ino; +} tail_data_t; + +typedef struct { + char *host; + int port; +} sock_data_t; + +typedef struct { + int fd; + int type; + int cookie; + scalar_t *callback; + union { + pipe_data_t pipe; + tail_data_t tail; + sock_data_t sock; + } me; +} files_t; + +extern void timer_callback(int, void *); +extern void input_callback(scalar_t *, int, char *); + +extern char *local_strdup_suffix(const char *string, const char *suffix); +extern char *local_strdup_prefix(const char *prefix, const char *string); + +extern int local_user(const char *username); + +extern int local_timer(double timeout, scalar_t *callback, int cookie); +extern int local_timer_get_cookie(int id); +extern scalar_t *local_timer_get_callback(int id); + +extern int local_pipe(char *pipe, scalar_t *callback, int cookie); +extern int local_tail(char *file, scalar_t *callback, int cookie); +extern int local_sock(char *host, int port, scalar_t *callback, int cookie); + +extern void local_atexit(void); +extern int local_files_get_descriptor(int id); +extern void local_pmdaMain(pmdaInterface *self); + +#endif /* LOCAL_H */ diff --git a/src/perl/PMDA/test.pl b/src/perl/PMDA/test.pl new file mode 100644 index 0000000..a40443d --- /dev/null +++ b/src/perl/PMDA/test.pl @@ -0,0 +1,93 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' +# +# Copyright (c) 2004 Silicon Graphics, Inc. All Rights Reserved. +# +# This program is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation; either version 2 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# + +######################### We start with some black magic to print on failure. + +BEGIN { $| = 1; print "1..4\n"; } +END {print "not ok 1\n" unless $loaded;} +use PCP::PMDA; +$loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +use vars qw( $cvalue $perlvalue $failed $cases ); + +`make -f Makefile cvalue`; + +# verify constants are defined and match their C counterparts +# - assuming here that the header file matches our PMDA.pm +# (d==define) +# +$failed = 0; +$cases = 0; +open(TEST, './cvalue d |') || die "cannot run test program 'cvalue'"; +while (<TEST>) { + /^(\w+)=(.*)$/; + $cvalue = $2; + $perlvalue = &$1; + unless ($perlvalue == $cvalue) { + print "$1: $perlvalue != $cvalue\n"; + $failed++; + } + $cases++; +} +close TEST; +if ($failed != 0) { print "not ok 2 (failed $failed of $cases cases)\n"; } +else { print "ok 2\n"; } + +######################### + +# test data initialisation via the pmda_pmid macro (i==id) +# +$failed = 0; +$cases = 0; +open(TEST, './cvalue i |') || die "cannot run test program 'cvalue'"; +while (<TEST>) { + /^PMDA_PMID: (\d+),(\d+) = (.*)$/; + $cvalue = $3; + $perlvalue = pmda_pmid($1, $2); + unless ($perlvalue == $cvalue) { + print "$1,$2: $perlvalue != $cvalue\n"; + $failed++; + } + $cases++; +} +close TEST; +if ($failed != 0) { print "not ok 3 (failed $failed of $cases cases)\n"; } +else { print "ok 3\n"; } + +# test data initialisation via the pmda_units macro (u==units) +# +$failed=0; +$cases = 0; +open(TEST, './cvalue u |') || die "cannot run test program 'cvalue'"; +while (<TEST>) { + /^pmUnits: {(\d+),}5(\d) = (.*)$/; + $cvalue = $7; + $perlvalue = pmda_units($1, $2, $3, $4, $5, $6); + unless ($perlvalue == $cvalue) { + print "$1,$2,$3,$4,$5,$6: $perlvalue != $cvalue\n"; + $failed++; + } + $cases++; +} +close TEST; +if ($failed != 0) { print "not ok 4 (failed $failed of $cases cases)\n"; } +else { print "ok 4\n"; } + + +######################### diff --git a/src/perl/PMDA/typemap b/src/perl/PMDA/typemap new file mode 100644 index 0000000..5846f97 --- /dev/null +++ b/src/perl/PMDA/typemap @@ -0,0 +1,27 @@ +###################################################################### +# INPUT/OUTPUT maps +# O_OBJECT -> links an opaque C object to a blessed Perl object. +# +TYPEMAP +pmdaInterface * O_OBJECT +pmdaInstid * T_PTROBJ + +###################################################################### +OUTPUT + +O_OBJECT + sv_setref_pv( $arg, CLASS, (void*)$var ); + + +###################################################################### +INPUT + +O_OBJECT + if (sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG)) + $var = ($type)SvIV((SV *)SvRV($arg)); + else { + warn(\"${Package}::$func_name() -- $var is not a blessed SV reference\"); + XSRETURN_UNDEF; + } + +###################################################################### |