/*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License (the "License").
* You may not use this file except in compliance with the License.
*
* You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at usr/src/OPENSOLARIS.LICENSE.
* If applicable, add the following below this CDDL HEADER, with the
* fields enclosed by brackets "[]" replaced with your own identifying
* information: Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*/
/*
* Copyright (c) 2014 Racktop Systems.
*/
/*
* Kstat.xs is a Perl XS (eXStension module) that makes the Solaris
* kstat(3KSTAT) facility available to Perl scripts. Kstat is a general-purpose
* mechanism for providing kernel statistics to users. The Solaris API is
* function-based (see the manpage for details), but for ease of use in Perl
* scripts this module presents the information as a nested hash data structure.
* It would be too inefficient to read every kstat in the system, so this module
* uses the Perl TIEHASH mechanism to implement a read-on-demand semantic, which
* only reads and updates kstats as and when they are actually accessed.
*/
/*
* Ignored raw kstats.
*
* Some raw kstats are ignored by this module, these are listed below. The
* most common reason is that the kstats are stored as arrays and the ks_ndata
* know how many records are in the array, so they can't be read.
*
* unix:*:sfmmu_percpu_stat
* This is stored as an array with one entry per cpu. Each element is of type
* struct sfmmu_percpu_stat. The ks_ndata and ks_data_size fields are bogus.
*
* ufs directio:*:UFS DirectIO Stats
* The structure definition used for these kstats (ufs_directio_kstats) is in a
* C file (uts/common/fs/ufs/ufs_directio.c) rather than a header file, so it
* isn't accessible.
*
* qlc:*:statistics
* This is a third-party driver for which we don't have source.
*
* mm:*:phys_installed
* This is stored as an array of uint64_t, with each pair of values being the
* (address, size) of a memory segment. The ks_ndata and ks_data_size fields
* are both zero.
*
* sockfs:*:sock_unix_list
* This is stored as an array with one entry per active socket. Each element
* is of type struct k_sockinfo. The ks_ndata and ks_data_size fields are both
* zero.
*
* Note that the ks_ndata and ks_data_size of many non-array raw kstats are
* also incorrect. The relevant assertions are therefore commented out in the
* appropriate raw kstat read routines.
*/
/* Kstat related includes */
#include <libgen.h>
#include <kstat.h>
#include <nfs/nfs_clnt.h>
/* Ultra-specific kstat includes */
#ifdef __sparc
#endif
/*
* Solaris #defines SP, which conflicts with the perl definition of SP
* We don't need the Solaris one, so get rid of it to avoid warnings
*/
/* Perl XS includes */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
/* Debug macros */
#define DEBUG_ID "Sun::Solaris::Kstat"
#ifdef KSTAT_DEBUG
#define PERL_ASSERT(EXP) \
#else
#define PERL_ASSERT(EXP) ((void)0)
#endif
/* Macros for saving the contents of KSTAT_RAW structures */
#if defined(HAS_QUAD) && defined(USE_64_BIT_INT)
#define NEW_IV(V) \
#define NEW_UV(V) \
#else
#define NEW_IV(V) \
#if defined(UVTYPE)
#define NEW_UV(V) \
# else
#define NEW_UV(V) \
#endif
#endif
#define NEW_HRTIME(V) \
#define SAVE_FNP(H, F, K) \
#define SAVE_STRING(H, S, K, SS) \
hv_store(H, #K, sizeof (#K) - 1, \
#define SAVE_INT32(H, S, K) \
#define SAVE_UINT32(H, S, K) \
#define SAVE_INT64(H, S, K) \
#define SAVE_UINT64(H, S, K) \
#define SAVE_HRTIME(H, S, K) \
/* Private structure used for saving kstat info in the tied hashes */
typedef struct {
char read; /* Kstat block has been read before */
char valid; /* Kstat still exists in kstat chain */
char strip_str; /* Strip KSTAT_DATA_CHAR fields */
} KstatInfo_t;
/* typedef for apply_to_ties callback functions */
/* typedef for raw kstat reader functions */
/* Hash of "module:name" to KSTAT_RAW read functions */
static HV *raw_kstat_lookup;
/*
* Kstats come in two flavours, named and raw. Raw kstats are just C structs,
* so we need a function per raw kstat to convert the C struct into the
* corresponding perl hash. All such conversion functions are in the following
* section.
*/
/*
*/
static void
{
/* PERL_ASSERT(kp->ks_ndata == 1); */
#ifdef STATISTICS /* see header file */
#endif
}
/*
*/
static void
{
/* PERL_ASSERT(kp->ks_ndata == 1); */
}
/*
*/
static void
{
/* PERL_ASSERT(kp->ks_ndata == 1); */
}
/*
*/
static void
{
/* PERL_ASSERT(kp->ks_ndata == 1); */
}
/*
*/
static void
{
/* PERL_ASSERT(kp->ks_ndata == 1); */
}
/*
* Definition in /usr/include/nfs/nfs_clnt.h
*/
static void
{
struct mntinfo_kstat *mntinfop;
/* PERL_ASSERT(kp->ks_ndata == 1); */
}
/*
* The following struct => hash functions are all only present on the sparc
* platform, so they are all conditionally compiled depending on __sparc
*/
/*
*/
#ifdef __sparc
static void
{
struct sfmmu_global_stat *sfmmugp;
/* PERL_ASSERT(kp->ks_ndata == 1); */
}
#endif
/*
*/
#ifdef __sparc
static void
{
struct sfmmu_tsbsize_stat *sfmmutp;
/* PERL_ASSERT(kp->ks_ndata == 1); */
}
#endif
/*
*/
#ifdef __sparc
static void
{
int i;
/* PERL_ASSERT(kp->ks_ndata == 1); */
}
}
#endif
/*
* Used by save_temperature to make CSV lists from arrays of
* short temperature values
*/
#ifdef __sparc
static SV *
{
}
return (list);
}
/*
*/
static void
{
struct temp_stats *tempsp;
/* PERL_ASSERT(kp->ks_ndata == 1); */
}
#endif
/*
* Not actually defined anywhere - just a short. Yuck.
*/
#ifdef __sparc
static void
{
short *shortp;
/* PERL_ASSERT(kp->ks_ndata == 1); */
}
#endif
/*
* (Well, sort of. Actually there's no structure, just a list of #defines
* enumerating *some* of the array indexes.)
*/
#ifdef __sparc
static void
{
/* PERL_ASSERT(kp->ks_ndata == 1); */
}
#endif
/*
*/
#ifdef __sparc
static void
{
int i;
/* PERL_ASSERT(kp->ks_ndata == 1); */
/* PERL_ASSERT(kp->ks_data_size == sizeof (struct ft_list)); */
i++, faultp++) {
}
}
#endif
/*
* We need to be able to find the function corresponding to a particular raw
* kstat. To do this we ignore the instance and glue the module and name
* together to form a composite key. We can then use the data in the kstat
* structure to find the appropriate function. We use a perl hash to manage the
* lookup, where the key is "module:name" and the value is a pointer to the
* appropriate C function.
*
* Note that some kstats include the instance number as part of the module
* we omit any digits from the module and name as we build the table in
* build_raw_kstat_loopup(), and we remove any digits from the module and name
* when we look up the functions in lookup_raw_kstat_fn()
*/
/*
* This function is called when the XS is first dlopen()ed, and builds the
* lookup table as described above.
*/
static void
{
/* Create new hash */
raw_kstat_lookup = newHV();
#ifdef __sparc
"unix:sfmmu_global_stat");
"unix:sfmmu_tsbsize_stat");
#endif
}
/*
* This finds and returns the raw kstat reader function corresponding to the
* supplied module and name. If no matching function exists, 0 is returned.
*/
{
register char *f, *t;
/* Copy across module & name, removing any digits - see comment above */
while (*f != '\0' && isdigit(*f)) { f++; }
*t = *f;
}
*t++ = ':';
for (f = name; *f != '\0'; f++, t++) {
while (*f != '\0' && isdigit(*f)) {
f++;
}
*t = *f;
}
*t = '\0';
/* look up & return the function, or teturn 0 if not found */
{
fnp = 0;
} else {
}
return (fnp);
}
/*
* This module converts the flat list returned by kstat_read() into a perl hash
* tree keyed on module, instance, name and statistic. The following functions
* provide code to create the nested hashes, and to iterate over them.
*/
/*
* Given module, instance and name keys return a pointer to the hash tied to
* the bottommost hash. If the hash already exists, we just return a pointer
* to it, otherwise we create the hash and any others also required above it in
* the hierarchy. The returned tiehash is blessed into the
* Sun::Solaris::Kstat::_Stat class, so that the appropriate TIEHASH methods are
* called when the bottommost hash is accessed. If the is_new parameter is
* non-null it will be set to TRUE if a new tie has been created, and FALSE if
* the tie already existed.
*/
static HV *
{
int k;
int new;
/* Create the keys */
/* Iteratively descend the tree, creating new hashes as required */
for (k = 0; k < 3; k++) {
/* If the entry doesn't exist, create it */
if (k < 2) {
}
new = 1;
/* Otherwise it already existed */
} else {
new = 0;
}
}
/* Create and bless a hash for the tie, if necessary */
if (new) {
/* Add TIEHASH magic */
/* Otherwise, just find the existing tied hash */
} else {
}
if (is_new) {
}
return (tie);
}
/*
* This is an iterator function used to traverse the hash hierarchy and apply
* the passed function to the tied hashes at the bottom of the hierarchy. If
* any of the callback functions return 0, 0 is returned, otherwise 1
*/
static int
{
int ret;
ret = 1;
/* Iterate over each module */
/* Iterate over each module:instance */
/* Iterate over each module:instance:name */
/* Get the tie */
PERL_ASSERTMSG(mg != 0,
"apply_to_ties: lost P magic");
/* Apply the callback */
ret = 0;
}
}
}
}
return (ret);
}
/*
* Mark this HV as valid - used by update() when pruning deleted kstat nodes
*/
static int
{
return (1);
}
/*
* Prune invalid kstat nodes. This is called when kstat_chain_update() detects
* that the kstat chain has been updated. This removes any hash tree entries
* that no longer have a corresponding kstat. If del is non-null it will be
* set to the keys of the deleted kstat nodes, if any. If any entries are
* deleted 1 will be retured, otherwise 0
*/
static int
{
int ret;
ret = 0;
/* Iterate over each module */
/* Iterate over each module:instance */
/* Iterate over each module:instance:name */
PERL_ASSERTMSG(mg != 0,
"prune_invalid: lost P magic");
PERL_ASSERTMSG(mg != 0,
"prune_invalid: lost ~ magic");
/* If this is marked as invalid, prune it */
if (((KstatInfo_t *)SvPVX(
if (del) {
newSVpvf("%s:%s:%s",
}
ret = 1;
}
}
/* If the module:instance:name hash is empty prune it */
}
}
/* If the module:instance hash is empty prune it */
}
}
return (ret);
}
/*
* such a list into the equivalent perl datatypes, and stores them in the passed
* hash.
*/
static void
{
int n;
case KSTAT_DATA_CHAR:
break;
case KSTAT_DATA_INT32:
break;
case KSTAT_DATA_UINT32:
break;
case KSTAT_DATA_INT64:
break;
case KSTAT_DATA_UINT64:
break;
case KSTAT_DATA_STRING:
else
break;
default:
PERL_ASSERTMSG(0, "kstat_read: invalid data type");
continue;
}
}
}
/*
* Save kstat interrupt statistics
*/
static void
{
int i;
static char *intr_names[] =
{ "hard", "soft", "watchdog", "spurious", "multiple_service" };
for (i = 0; i < KSTAT_NUM_INTRS; i++) {
}
}
/*
* Save IO statistics
*/
static void
{
}
/*
* Save timer statistics
*/
static void
{
}
/*
* Read kstats and copy into the supplied perl hash structure. If refresh is
* true, this function is being called as part of the update() method. In this
* case it is only necessary to read the kstats if they have previously been
* accessed (kip->read == TRUE). If refresh is false, this function is being
* called prior to returning a value to the caller. In this case, it is only
* necessary to read the kstats if they have not previously been read. If the
* kstat_read() fails, 0 is returned, otherwise 1
*/
static int
{
/* Find the MAGIC KstatInfo_t data structure */
/* Return early if we don't need to actually read the kstats */
return (1);
}
/* Read the kstats and return 0 if this fails */
return (0);
}
/* Save the read data */
case KSTAT_TYPE_RAW:
}
break;
case KSTAT_TYPE_NAMED:
break;
case KSTAT_TYPE_INTR:
break;
case KSTAT_TYPE_IO:
break;
case KSTAT_TYPE_TIMER:
break;
default:
PERL_ASSERTMSG(0, "read_kstats: illegal kstat type");
break;
}
return (1);
}
/*
* The XS code exported to perl is below here. Note that the XS preprocessor
* has its own commenting syntax, so all comments from this point on are in
* that form.
*/
/* The following XS methods are the ABI of the Sun::Solaris::Kstat package */
BOOT:
#
# underlying kstats. This is done on demand by the TIEHASH methods in
# Sun::Solaris::Kstat::_Stat
#
SV*
new(class, ...)
char *class;
PREINIT:
HV *stash;
kstat_ctl_t *kc;
SV *kcsv;
kstat_t *kp;
KstatInfo_t kstatinfo;
int sp, strip_str;
CODE:
/* Check we have an even number of arguments, excluding the class */
sp = 1;
if (((items - sp) % 2) != 0) {
croak(DEBUG_ID ": new: invalid number of arguments");
}
/* Process any (name => value) arguments */
strip_str = 0;
while (sp < items) {
SV *name, *value;
name = ST(sp);
sp++;
value = ST(sp);
sp++;
if (strcmp(SvPVX(name), "strip_strings") == 0) {
strip_str = SvTRUE(value);
} else {
croak(DEBUG_ID ": new: invalid parameter name '%s'",
SvPVX(name));
}
}
/* Open the kstats handle */
if ((kc = kstat_open()) == 0) {
XSRETURN_UNDEF;
}
/* Create a blessed hash ref */
RETVAL = (SV *)newRV_noinc((SV *)newHV());
stash = gv_stashpv(class, TRUE);
sv_bless(RETVAL, stash);
/* Create a place to save the KstatInfo_t structure */
kcsv = newSVpv((char *)&kc, sizeof (kc));
sv_magic(SvRV(RETVAL), kcsv, '~', 0, 0);
SvREFCNT_dec(kcsv);
/* Initialise the KstatsInfo_t structure */
kstatinfo.read = FALSE;
kstatinfo.valid = TRUE;
kstatinfo.strip_str = strip_str;
kstatinfo.kstat_ctl = kc;
/* Scan the kstat chain, building hash entries for the kstats */
for (kp = kc->kc_chain; kp != 0; kp = kp->ks_next) {
HV *tie;
SV *kstatsv;
continue;
}
/* Don't bother storing raw stats we don't understand */
#ifdef REPORT_UNKNOWN
"Unknown kstat type %s:%d:%s - %d of size %d\n",
#endif
continue;
}
/* Create a 3-layer hash hierarchy - module.instance.name */
/* Save the data necessary to read the kstat info on demand */
}
/* SvREADONLY_on(RETVAL); */
#
#
void
int ret;
/* Find the hidden KstatInfo_t structure */
/* Update the kstat chain, and return immediately on error. */
PUSHs(sv_newmortal());
PUSHs(sv_newmortal());
} else {
}
}
/* Create the arrays to be returned if in an array context */
} else {
add = 0;
del = 0;
}
/*
* If the kstat chain hasn't changed we can just reread any stats
* that have already been read
*/
if (ret == 0) {
} else {
}
}
/*
* Otherwise we have to update the Perl structure so that it is in
* agreement with the new kstat chain. We do this in such a way as to
* retain all the existing structures, just adding or deleting the
* bare minimum.
*/
} else {
/*
* Step 1: set the 'invalid' flag on each entry
*/
/*
* Step 2: Set the 'valid' flag on all entries still in the
* kernel kstat chain
*/
int new;
/* Don't bother storing the kstat headers or types */
continue;
}
/* Don't bother storing raw stats we don't understand */
== 0) {
#ifdef REPORT_UNKNOWN
(void) printf("Unknown kstat type %s:%d:%s "
#endif
continue;
}
/* Find the tied hash associated with the kstat entry */
/* If newly created store the associated kstat info */
if (new) {
/*
* Save the data necessary to read the kstat
* info on demand
*/
sizeof (kstatinfo));
/* Save the key on the add list, if required */
}
/* If the stats already exist, just update them */
} else {
/* Find the hidden KstatInfo_t */
/* Mark the tie as valid */
/* Re-save the kstat_t pointer. If the kstat
* has been deleted and re-added since the last
* update, the address of the kstat structure
* will have changed, even though the kstat will
* still live at the same place in the perl
* hash tree structure.
*/
/* Reread the stats, if read previously */
}
}
/*
*Step 3: Delete any entries still marked as 'invalid'
*/
}
} else {
}
#
#
void
CODE:
if (kstat_close(kc) != 0) {
}
#
# visible to callers of the Sun::Solaris::Kstat module
#
MODULE = Sun::Solaris::Kstat PACKAGE = Sun::Solaris::Kstat::_Stat
PROTOTYPES: ENABLE
#
# If a value has already been read, return it. Otherwise read the appropriate
# kstat and then return the value
#
SV*
FETCH(self, key)
SV* self;
SV* key;
PREINIT:
char *k;
STRLEN klen;
SV **value;
CODE:
self = SvRV(self);
k = SvPV(key, klen);
if (strNE(k, "class") && strNE(k, "crtime")) {
read_kstats((HV *)self, FALSE);
}
value = hv_fetch((HV *)self, k, klen, FALSE);
if (value) {
RETVAL = *value; SvREFCNT_inc(RETVAL);
} else {
RETVAL = &PL_sv_undef;
}
OUTPUT:
RETVAL
#
# Save the passed value into the kstat hash. Read the appropriate kstat first,
# if necessary. Note that this DOES NOT update the underlying kernel kstat
# structure.
#
SV*
STORE(self, key, value)
SV* self;
SV* key;
SV* value;
PREINIT:
char *k;
STRLEN klen;
CODE:
self = SvRV(self);
k = SvPV(key, klen);
if (strNE(k, "class") && strNE(k, "crtime")) {
read_kstats((HV *)self, FALSE);
}
SvREFCNT_inc(value);
RETVAL = *(hv_store((HV *)self, k, klen, value, 0));
SvREFCNT_inc(RETVAL);
OUTPUT:
RETVAL
#
# Check for the existence of the passed key. Read the kstat first if necessary
#
bool
EXISTS(self, key)
SV* self;
SV* key;
PREINIT:
char *k;
CODE:
self = SvRV(self);
k = SvPV(key, PL_na);
if (strNE(k, "class") && strNE(k, "crtime")) {
read_kstats((HV *)self, FALSE);
}
RETVAL = hv_exists_ent((HV *)self, key, 0);
OUTPUT:
RETVAL
#
# Hash iterator initialisation. Read the kstats if necessary.
#
SV*
FIRSTKEY(self)
SV* self;
PREINIT:
HE *he;
PPCODE:
self = SvRV(self);
read_kstats((HV *)self, FALSE);
hv_iterinit((HV *)self);
if ((he = hv_iternext((HV *)self))) {
EXTEND(SP, 1);
PUSHs(hv_iterkeysv(he));
}
#
# Return hash iterator next value. Read the kstats if necessary.
#
SV*
NEXTKEY(self, lastkey)
SV* self;
SV* lastkey;
PREINIT:
HE *he;
PPCODE:
self = SvRV(self);
if ((he = hv_iternext((HV *)self))) {
EXTEND(SP, 1);
PUSHs(hv_iterkeysv(he));
}
#
# Delete the specified hash entry.
#
SV*
DELETE(self, key)
SV *self;
SV *key;
CODE:
self = SvRV(self);
RETVAL = hv_delete_ent((HV *)self, key, 0, 0);
if (RETVAL) {
SvREFCNT_inc(RETVAL);
} else {
RETVAL = &PL_sv_undef;
}
OUTPUT:
RETVAL
#
# Clear the entire hash. This will stop any update() calls rereading this
# kstat until it is accessed again.
#
void
CLEAR(self)
SV* self;
PREINIT:
MAGIC *mg;
KstatInfo_t *kip;
CODE:
self = SvRV(self);
hv_clear((HV *)self);
mg = mg_find(self, '~');
PERL_ASSERTMSG(mg != 0, "CLEAR: lost ~ magic");
kip = (KstatInfo_t *)SvPVX(mg->mg_obj);
kip->read = FALSE;
kip->valid = TRUE;
hv_store((HV *)self, "class", 5, newSVpv(kip->kstat->ks_class, 0), 0);
hv_store((HV *)self, "crtime", 6, NEW_HRTIME(kip->kstat->ks_crtime), 0);