diff options
author | Igor Pashev <pashev.igor@gmail.com> | 2014-03-30 20:08:05 +0400 |
---|---|---|
committer | Igor Pashev <pashev.igor@gmail.com> | 2014-03-30 20:08:05 +0400 |
commit | 04648d22aa0b8cb191a4b56597577175cd0e7b48 (patch) | |
tree | af7596c262b047c6eed3ed5ed47e4e51cca810b7 | |
download | kstat-perl-04648d22aa0b8cb191a4b56597577175cd0e7b48.tar.gz |
Imported Sun-Solaris-Kstat-1.3 from illumos Wed Apr 18 22:20:23 2012 +0000upstream/1.3upstream
-rw-r--r-- | Kstat.pm | 38 | ||||
-rw-r--r-- | Kstat.xs | 1690 | ||||
-rw-r--r-- | META.yml | 20 | ||||
-rw-r--r-- | Makefile.PL | 60 | ||||
-rw-r--r-- | t/Kstat.t | 177 |
5 files changed, 1985 insertions, 0 deletions
diff --git a/Kstat.pm b/Kstat.pm new file mode 100644 index 0000000..b1ae5db --- /dev/null +++ b/Kstat.pm @@ -0,0 +1,38 @@ +# +# 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 +# or http://www.opensolaris.org/os/licensing. +# 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 2006 Sun Microsystems, Inc. All rights reserved. +# Use is subject to license terms. +# + +# +# Kstat.pm provides the bootstrap for the Sun::Solaris::Kstat module. +# + +package Sun::Solaris::Kstat; +use strict; +use DynaLoader; +use vars qw($VERSION @ISA); +$VERSION = '1.3'; +@ISA = qw(DynaLoader); +bootstrap Sun::Solaris::Kstat $VERSION; +1; diff --git a/Kstat.xs b/Kstat.xs new file mode 100644 index 0000000..403c95f --- /dev/null +++ b/Kstat.xs @@ -0,0 +1,1690 @@ +/* + * 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 + * or http://www.opensolaris.org/os/licensing. + * 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) 1999, 2010, Oracle and/or its affiliates. All rights reserved. + */ + +/* + * 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 + * and/or ks_data_size fields are invalid. In this case it is impossible to + * 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 <sys/var.h> +#include <sys/utsname.h> +#include <sys/sysinfo.h> +#include <sys/flock.h> +#include <sys/dnlc.h> +#include <nfs/nfs.h> +#include <nfs/nfs_clnt.h> + +/* Ultra-specific kstat includes */ +#ifdef __sparc +#include <vm/hat_sfmmu.h> /* from /usr/platform/sun4u/include */ +#include <sys/simmstat.h> /* from /usr/platform/sun4u/include */ +#include <sys/sysctrl.h> /* from /usr/platform/sun4u/include */ +#include <sys/fhc.h> /* from /usr/include */ +#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 + */ +#undef SP + +/* 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) \ + ((void)((EXP) || (croak("%s: assertion failed at %s:%d: %s", \ + DEBUG_ID, __FILE__, __LINE__, #EXP), 0), 0)) +#define PERL_ASSERTMSG(EXP, MSG) \ + ((void)((EXP) || (croak(DEBUG_ID ": " MSG), 0), 0)) +#else +#define PERL_ASSERT(EXP) ((void)0) +#define PERL_ASSERTMSG(EXP, MSG) ((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) \ + (newSViv((IVTYPE) V)) +#define NEW_UV(V) \ + (newSVuv((UVTYPE) V)) +#else +#define NEW_IV(V) \ + (V >= IV_MIN && V <= IV_MAX ? newSViv((IVTYPE) V) : newSVnv((NVTYPE) V)) +#if defined(UVTYPE) +#define NEW_UV(V) \ + (V <= UV_MAX ? newSVuv((UVTYPE) V) : newSVnv((NVTYPE) V)) +# else +#define NEW_UV(V) \ + (V <= IV_MAX ? newSViv((IVTYPE) V) : newSVnv((NVTYPE) V)) +#endif +#endif +#define NEW_HRTIME(V) \ + newSVnv((NVTYPE) (V / 1000000000.0)) + +#define SAVE_FNP(H, F, K) \ + hv_store(H, K, sizeof (K) - 1, newSViv((IVTYPE)(uintptr_t)&F), 0) +#define SAVE_STRING(H, S, K, SS) \ + hv_store(H, #K, sizeof (#K) - 1, \ + newSVpvn(S->K, SS ? strlen(S->K) : sizeof(S->K)), 0) +#define SAVE_INT32(H, S, K) \ + hv_store(H, #K, sizeof (#K) - 1, NEW_IV(S->K), 0) +#define SAVE_UINT32(H, S, K) \ + hv_store(H, #K, sizeof (#K) - 1, NEW_UV(S->K), 0) +#define SAVE_INT64(H, S, K) \ + hv_store(H, #K, sizeof (#K) - 1, NEW_IV(S->K), 0) +#define SAVE_UINT64(H, S, K) \ + hv_store(H, #K, sizeof (#K) - 1, NEW_UV(S->K), 0) +#define SAVE_HRTIME(H, S, K) \ + hv_store(H, #K, sizeof (#K) - 1, NEW_HRTIME(S->K), 0) + +/* 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 */ + kstat_ctl_t *kstat_ctl; /* Handle returned by kstat_open */ + kstat_t *kstat; /* Handle used by kstat_read */ +} KstatInfo_t; + +/* typedef for apply_to_ties callback functions */ +typedef int (*ATTCb_t)(HV *, void *); + +/* typedef for raw kstat reader functions */ +typedef void (*kstat_raw_reader_t)(HV *, kstat_t *, int); + +/* 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. + */ + +/* + * Definitions in /usr/include/sys/cpuvar.h and /usr/include/sys/sysinfo.h + */ + +static void +save_cpu_stat(HV *self, kstat_t *kp, int strip_str) +{ + cpu_stat_t *statp; + cpu_sysinfo_t *sysinfop; + cpu_syswait_t *syswaitp; + cpu_vminfo_t *vminfop; + + /* PERL_ASSERT(kp->ks_ndata == 1); */ + PERL_ASSERT(kp->ks_data_size == sizeof (cpu_stat_t)); + statp = (cpu_stat_t *)(kp->ks_data); + sysinfop = &statp->cpu_sysinfo; + syswaitp = &statp->cpu_syswait; + vminfop = &statp->cpu_vminfo; + + hv_store(self, "idle", 4, NEW_UV(sysinfop->cpu[CPU_IDLE]), 0); + hv_store(self, "user", 4, NEW_UV(sysinfop->cpu[CPU_USER]), 0); + hv_store(self, "kernel", 6, NEW_UV(sysinfop->cpu[CPU_KERNEL]), 0); + hv_store(self, "wait", 4, NEW_UV(sysinfop->cpu[CPU_WAIT]), 0); + hv_store(self, "wait_io", 7, NEW_UV(sysinfop->wait[W_IO]), 0); + hv_store(self, "wait_swap", 9, NEW_UV(sysinfop->wait[W_SWAP]), 0); + hv_store(self, "wait_pio", 8, NEW_UV(sysinfop->wait[W_PIO]), 0); + SAVE_UINT32(self, sysinfop, bread); + SAVE_UINT32(self, sysinfop, bwrite); + SAVE_UINT32(self, sysinfop, lread); + SAVE_UINT32(self, sysinfop, lwrite); + SAVE_UINT32(self, sysinfop, phread); + SAVE_UINT32(self, sysinfop, phwrite); + SAVE_UINT32(self, sysinfop, pswitch); + SAVE_UINT32(self, sysinfop, trap); + SAVE_UINT32(self, sysinfop, intr); + SAVE_UINT32(self, sysinfop, syscall); + SAVE_UINT32(self, sysinfop, sysread); + SAVE_UINT32(self, sysinfop, syswrite); + SAVE_UINT32(self, sysinfop, sysfork); + SAVE_UINT32(self, sysinfop, sysvfork); + SAVE_UINT32(self, sysinfop, sysexec); + SAVE_UINT32(self, sysinfop, readch); + SAVE_UINT32(self, sysinfop, writech); + SAVE_UINT32(self, sysinfop, rcvint); + SAVE_UINT32(self, sysinfop, xmtint); + SAVE_UINT32(self, sysinfop, mdmint); + SAVE_UINT32(self, sysinfop, rawch); + SAVE_UINT32(self, sysinfop, canch); + SAVE_UINT32(self, sysinfop, outch); + SAVE_UINT32(self, sysinfop, msg); + SAVE_UINT32(self, sysinfop, sema); + SAVE_UINT32(self, sysinfop, namei); + SAVE_UINT32(self, sysinfop, ufsiget); + SAVE_UINT32(self, sysinfop, ufsdirblk); + SAVE_UINT32(self, sysinfop, ufsipage); + SAVE_UINT32(self, sysinfop, ufsinopage); + SAVE_UINT32(self, sysinfop, inodeovf); + SAVE_UINT32(self, sysinfop, fileovf); + SAVE_UINT32(self, sysinfop, procovf); + SAVE_UINT32(self, sysinfop, intrthread); + SAVE_UINT32(self, sysinfop, intrblk); + SAVE_UINT32(self, sysinfop, idlethread); + SAVE_UINT32(self, sysinfop, inv_swtch); + SAVE_UINT32(self, sysinfop, nthreads); + SAVE_UINT32(self, sysinfop, cpumigrate); + SAVE_UINT32(self, sysinfop, xcalls); + SAVE_UINT32(self, sysinfop, mutex_adenters); + SAVE_UINT32(self, sysinfop, rw_rdfails); + SAVE_UINT32(self, sysinfop, rw_wrfails); + SAVE_UINT32(self, sysinfop, modload); + SAVE_UINT32(self, sysinfop, modunload); + SAVE_UINT32(self, sysinfop, bawrite); +#ifdef STATISTICS /* see header file */ + SAVE_UINT32(self, sysinfop, rw_enters); + SAVE_UINT32(self, sysinfop, win_uo_cnt); + SAVE_UINT32(self, sysinfop, win_uu_cnt); + SAVE_UINT32(self, sysinfop, win_so_cnt); + SAVE_UINT32(self, sysinfop, win_su_cnt); + SAVE_UINT32(self, sysinfop, win_suo_cnt); +#endif + + SAVE_INT32(self, syswaitp, iowait); + SAVE_INT32(self, syswaitp, swap); + SAVE_INT32(self, syswaitp, physio); + + SAVE_UINT32(self, vminfop, pgrec); + SAVE_UINT32(self, vminfop, pgfrec); + SAVE_UINT32(self, vminfop, pgin); + SAVE_UINT32(self, vminfop, pgpgin); + SAVE_UINT32(self, vminfop, pgout); + SAVE_UINT32(self, vminfop, pgpgout); + SAVE_UINT32(self, vminfop, swapin); + SAVE_UINT32(self, vminfop, pgswapin); + SAVE_UINT32(self, vminfop, swapout); + SAVE_UINT32(self, vminfop, pgswapout); + SAVE_UINT32(self, vminfop, zfod); + SAVE_UINT32(self, vminfop, dfree); + SAVE_UINT32(self, vminfop, scan); + SAVE_UINT32(self, vminfop, rev); + SAVE_UINT32(self, vminfop, hat_fault); + SAVE_UINT32(self, vminfop, as_fault); + SAVE_UINT32(self, vminfop, maj_fault); + SAVE_UINT32(self, vminfop, cow_fault); + SAVE_UINT32(self, vminfop, prot_fault); + SAVE_UINT32(self, vminfop, softlock); + SAVE_UINT32(self, vminfop, kernel_asflt); + SAVE_UINT32(self, vminfop, pgrrun); + SAVE_UINT32(self, vminfop, execpgin); + SAVE_UINT32(self, vminfop, execpgout); + SAVE_UINT32(self, vminfop, execfree); + SAVE_UINT32(self, vminfop, anonpgin); + SAVE_UINT32(self, vminfop, anonpgout); + SAVE_UINT32(self, vminfop, anonfree); + SAVE_UINT32(self, vminfop, fspgin); + SAVE_UINT32(self, vminfop, fspgout); + SAVE_UINT32(self, vminfop, fsfree); +} + +/* + * Definitions in /usr/include/sys/var.h + */ + +static void +save_var(HV *self, kstat_t *kp, int strip_str) +{ + struct var *varp; + + /* PERL_ASSERT(kp->ks_ndata == 1); */ + PERL_ASSERT(kp->ks_data_size == sizeof (struct var)); + varp = (struct var *)(kp->ks_data); + + SAVE_INT32(self, varp, v_buf); + SAVE_INT32(self, varp, v_call); + SAVE_INT32(self, varp, v_proc); + SAVE_INT32(self, varp, v_maxupttl); + SAVE_INT32(self, varp, v_nglobpris); + SAVE_INT32(self, varp, v_maxsyspri); + SAVE_INT32(self, varp, v_clist); + SAVE_INT32(self, varp, v_maxup); + SAVE_INT32(self, varp, v_hbuf); + SAVE_INT32(self, varp, v_hmask); + SAVE_INT32(self, varp, v_pbuf); + SAVE_INT32(self, varp, v_sptmap); + SAVE_INT32(self, varp, v_maxpmem); + SAVE_INT32(self, varp, v_autoup); + SAVE_INT32(self, varp, v_bufhwm); +} + +/* + * Definition in /usr/include/sys/dnlc.h + */ + +static void +save_ncstats(HV *self, kstat_t *kp, int strip_str) +{ + struct ncstats *ncstatsp; + + /* PERL_ASSERT(kp->ks_ndata == 1); */ + PERL_ASSERT(kp->ks_data_size == sizeof (struct ncstats)); + ncstatsp = (struct ncstats *)(kp->ks_data); + + SAVE_INT32(self, ncstatsp, hits); + SAVE_INT32(self, ncstatsp, misses); + SAVE_INT32(self, ncstatsp, enters); + SAVE_INT32(self, ncstatsp, dbl_enters); + SAVE_INT32(self, ncstatsp, long_enter); + SAVE_INT32(self, ncstatsp, long_look); + SAVE_INT32(self, ncstatsp, move_to_front); + SAVE_INT32(self, ncstatsp, purges); +} + +/* + * Definition in /usr/include/sys/sysinfo.h + */ + +static void +save_sysinfo(HV *self, kstat_t *kp, int strip_str) +{ + sysinfo_t *sysinfop; + + /* PERL_ASSERT(kp->ks_ndata == 1); */ + PERL_ASSERT(kp->ks_data_size == sizeof (sysinfo_t)); + sysinfop = (sysinfo_t *)(kp->ks_data); + + SAVE_UINT32(self, sysinfop, updates); + SAVE_UINT32(self, sysinfop, runque); + SAVE_UINT32(self, sysinfop, runocc); + SAVE_UINT32(self, sysinfop, swpque); + SAVE_UINT32(self, sysinfop, swpocc); + SAVE_UINT32(self, sysinfop, waiting); +} + +/* + * Definition in /usr/include/sys/sysinfo.h + */ + +static void +save_vminfo(HV *self, kstat_t *kp, int strip_str) +{ + vminfo_t *vminfop; + + /* PERL_ASSERT(kp->ks_ndata == 1); */ + PERL_ASSERT(kp->ks_data_size == sizeof (vminfo_t)); + vminfop = (vminfo_t *)(kp->ks_data); + + SAVE_UINT64(self, vminfop, freemem); + SAVE_UINT64(self, vminfop, swap_resv); + SAVE_UINT64(self, vminfop, swap_alloc); + SAVE_UINT64(self, vminfop, swap_avail); + SAVE_UINT64(self, vminfop, swap_free); + SAVE_UINT64(self, vminfop, updates); +} + +/* + * Definition in /usr/include/nfs/nfs_clnt.h + */ + +static void +save_nfs(HV *self, kstat_t *kp, int strip_str) +{ + struct mntinfo_kstat *mntinfop; + + /* PERL_ASSERT(kp->ks_ndata == 1); */ + PERL_ASSERT(kp->ks_data_size == sizeof (struct mntinfo_kstat)); + mntinfop = (struct mntinfo_kstat *)(kp->ks_data); + + SAVE_STRING(self, mntinfop, mik_proto, strip_str); + SAVE_UINT32(self, mntinfop, mik_vers); + SAVE_UINT32(self, mntinfop, mik_flags); + SAVE_UINT32(self, mntinfop, mik_secmod); + SAVE_UINT32(self, mntinfop, mik_curread); + SAVE_UINT32(self, mntinfop, mik_curwrite); + SAVE_INT32(self, mntinfop, mik_timeo); + SAVE_INT32(self, mntinfop, mik_retrans); + SAVE_UINT32(self, mntinfop, mik_acregmin); + SAVE_UINT32(self, mntinfop, mik_acregmax); + SAVE_UINT32(self, mntinfop, mik_acdirmin); + SAVE_UINT32(self, mntinfop, mik_acdirmax); + hv_store(self, "lookup_srtt", 11, + NEW_UV(mntinfop->mik_timers[0].srtt), 0); + hv_store(self, "lookup_deviate", 14, + NEW_UV(mntinfop->mik_timers[0].deviate), 0); + hv_store(self, "lookup_rtxcur", 13, + NEW_UV(mntinfop->mik_timers[0].rtxcur), 0); + hv_store(self, "read_srtt", 9, + NEW_UV(mntinfop->mik_timers[1].srtt), 0); + hv_store(self, "read_deviate", 12, + NEW_UV(mntinfop->mik_timers[1].deviate), 0); + hv_store(self, "read_rtxcur", 11, + NEW_UV(mntinfop->mik_timers[1].rtxcur), 0); + hv_store(self, "write_srtt", 10, + NEW_UV(mntinfop->mik_timers[2].srtt), 0); + hv_store(self, "write_deviate", 13, + NEW_UV(mntinfop->mik_timers[2].deviate), 0); + hv_store(self, "write_rtxcur", 12, + NEW_UV(mntinfop->mik_timers[2].rtxcur), 0); + SAVE_UINT32(self, mntinfop, mik_noresponse); + SAVE_UINT32(self, mntinfop, mik_failover); + SAVE_UINT32(self, mntinfop, mik_remap); + SAVE_STRING(self, mntinfop, mik_curserver, strip_str); +} + +/* + * The following struct => hash functions are all only present on the sparc + * platform, so they are all conditionally compiled depending on __sparc + */ + +/* + * Definition in /usr/platform/sun4u/include/vm/hat_sfmmu.h + */ + +#ifdef __sparc +static void +save_sfmmu_global_stat(HV *self, kstat_t *kp, int strip_str) +{ + struct sfmmu_global_stat *sfmmugp; + + /* PERL_ASSERT(kp->ks_ndata == 1); */ + PERL_ASSERT(kp->ks_data_size == sizeof (struct sfmmu_global_stat)); + sfmmugp = (struct sfmmu_global_stat *)(kp->ks_data); + + SAVE_INT32(self, sfmmugp, sf_tsb_exceptions); + SAVE_INT32(self, sfmmugp, sf_tsb_raise_exception); + SAVE_INT32(self, sfmmugp, sf_pagefaults); + SAVE_INT32(self, sfmmugp, sf_uhash_searches); + SAVE_INT32(self, sfmmugp, sf_uhash_links); + SAVE_INT32(self, sfmmugp, sf_khash_searches); + SAVE_INT32(self, sfmmugp, sf_khash_links); + SAVE_INT32(self, sfmmugp, sf_swapout); + SAVE_INT32(self, sfmmugp, sf_tsb_alloc); + SAVE_INT32(self, sfmmugp, sf_tsb_allocfail); + SAVE_INT32(self, sfmmugp, sf_tsb_sectsb_create); + SAVE_INT32(self, sfmmugp, sf_scd_1sttsb_alloc); + SAVE_INT32(self, sfmmugp, sf_scd_2ndtsb_alloc); + SAVE_INT32(self, sfmmugp, sf_scd_1sttsb_allocfail); + SAVE_INT32(self, sfmmugp, sf_scd_2ndtsb_allocfail); + SAVE_INT32(self, sfmmugp, sf_tteload8k); + SAVE_INT32(self, sfmmugp, sf_tteload64k); + SAVE_INT32(self, sfmmugp, sf_tteload512k); + SAVE_INT32(self, sfmmugp, sf_tteload4m); + SAVE_INT32(self, sfmmugp, sf_tteload32m); + SAVE_INT32(self, sfmmugp, sf_tteload256m); + SAVE_INT32(self, sfmmugp, sf_tsb_load8k); + SAVE_INT32(self, sfmmugp, sf_tsb_load4m); + SAVE_INT32(self, sfmmugp, sf_hblk_hit); + SAVE_INT32(self, sfmmugp, sf_hblk8_ncreate); + SAVE_INT32(self, sfmmugp, sf_hblk8_nalloc); + SAVE_INT32(self, sfmmugp, sf_hblk1_ncreate); + SAVE_INT32(self, sfmmugp, sf_hblk1_nalloc); + SAVE_INT32(self, sfmmugp, sf_hblk_slab_cnt); + SAVE_INT32(self, sfmmugp, sf_hblk_reserve_cnt); + SAVE_INT32(self, sfmmugp, sf_hblk_recurse_cnt); + SAVE_INT32(self, sfmmugp, sf_hblk_reserve_hit); + SAVE_INT32(self, sfmmugp, sf_get_free_success); + SAVE_INT32(self, sfmmugp, sf_get_free_throttle); + SAVE_INT32(self, sfmmugp, sf_get_free_fail); + SAVE_INT32(self, sfmmugp, sf_put_free_success); + SAVE_INT32(self, sfmmugp, sf_put_free_fail); + SAVE_INT32(self, sfmmugp, sf_pgcolor_conflict); + SAVE_INT32(self, sfmmugp, sf_uncache_conflict); + SAVE_INT32(self, sfmmugp, sf_unload_conflict); + SAVE_INT32(self, sfmmugp, sf_ism_uncache); + SAVE_INT32(self, sfmmugp, sf_ism_recache); + SAVE_INT32(self, sfmmugp, sf_recache); + SAVE_INT32(self, sfmmugp, sf_steal_count); + SAVE_INT32(self, sfmmugp, sf_pagesync); + SAVE_INT32(self, sfmmugp, sf_clrwrt); + SAVE_INT32(self, sfmmugp, sf_pagesync_invalid); + SAVE_INT32(self, sfmmugp, sf_kernel_xcalls); + SAVE_INT32(self, sfmmugp, sf_user_xcalls); + SAVE_INT32(self, sfmmugp, sf_tsb_grow); + SAVE_INT32(self, sfmmugp, sf_tsb_shrink); + SAVE_INT32(self, sfmmugp, sf_tsb_resize_failures); + SAVE_INT32(self, sfmmugp, sf_tsb_reloc); + SAVE_INT32(self, sfmmugp, sf_user_vtop); + SAVE_INT32(self, sfmmugp, sf_ctx_inv); + SAVE_INT32(self, sfmmugp, sf_tlb_reprog_pgsz); + SAVE_INT32(self, sfmmugp, sf_region_remap_demap); + SAVE_INT32(self, sfmmugp, sf_create_scd); + SAVE_INT32(self, sfmmugp, sf_join_scd); + SAVE_INT32(self, sfmmugp, sf_leave_scd); + SAVE_INT32(self, sfmmugp, sf_destroy_scd); +} +#endif + +/* + * Definition in /usr/platform/sun4u/include/vm/hat_sfmmu.h + */ + +#ifdef __sparc +static void +save_sfmmu_tsbsize_stat(HV *self, kstat_t *kp, int strip_str) +{ + struct sfmmu_tsbsize_stat *sfmmutp; + + /* PERL_ASSERT(kp->ks_ndata == 1); */ + PERL_ASSERT(kp->ks_data_size == sizeof (struct sfmmu_tsbsize_stat)); + sfmmutp = (struct sfmmu_tsbsize_stat *)(kp->ks_data); + + SAVE_INT32(self, sfmmutp, sf_tsbsz_8k); + SAVE_INT32(self, sfmmutp, sf_tsbsz_16k); + SAVE_INT32(self, sfmmutp, sf_tsbsz_32k); + SAVE_INT32(self, sfmmutp, sf_tsbsz_64k); + SAVE_INT32(self, sfmmutp, sf_tsbsz_128k); + SAVE_INT32(self, sfmmutp, sf_tsbsz_256k); + SAVE_INT32(self, sfmmutp, sf_tsbsz_512k); + SAVE_INT32(self, sfmmutp, sf_tsbsz_1m); + SAVE_INT32(self, sfmmutp, sf_tsbsz_2m); + SAVE_INT32(self, sfmmutp, sf_tsbsz_4m); +} +#endif + +/* + * Definition in /usr/platform/sun4u/include/sys/simmstat.h + */ + +#ifdef __sparc +static void +save_simmstat(HV *self, kstat_t *kp, int strip_str) +{ + uchar_t *simmstatp; + SV *list; + int i; + + /* PERL_ASSERT(kp->ks_ndata == 1); */ + PERL_ASSERT(kp->ks_data_size == sizeof (uchar_t) * SIMM_COUNT); + + list = newSVpv("", 0); + for (i = 0, simmstatp = (uchar_t *)(kp->ks_data); + i < SIMM_COUNT - 1; i++, simmstatp++) { + sv_catpvf(list, "%d,", *simmstatp); + } + sv_catpvf(list, "%d", *simmstatp); + hv_store(self, "status", 6, list, 0); +} +#endif + +/* + * Used by save_temperature to make CSV lists from arrays of + * short temperature values + */ + +#ifdef __sparc +static SV * +short_array_to_SV(short *shortp, int len) +{ + SV *list; + + list = newSVpv("", 0); + for (; len > 1; len--, shortp++) { + sv_catpvf(list, "%d,", *shortp); + } + sv_catpvf(list, "%d", *shortp); + return (list); +} + +/* + * Definition in /usr/platform/sun4u/include/sys/fhc.h + */ + +static void +save_temperature(HV *self, kstat_t *kp, int strip_str) +{ + struct temp_stats *tempsp; + + /* PERL_ASSERT(kp->ks_ndata == 1); */ + PERL_ASSERT(kp->ks_data_size == sizeof (struct temp_stats)); + tempsp = (struct temp_stats *)(kp->ks_data); + + SAVE_UINT32(self, tempsp, index); + hv_store(self, "l1", 2, short_array_to_SV(tempsp->l1, L1_SZ), 0); + hv_store(self, "l2", 2, short_array_to_SV(tempsp->l2, L2_SZ), 0); + hv_store(self, "l3", 2, short_array_to_SV(tempsp->l3, L3_SZ), 0); + hv_store(self, "l4", 2, short_array_to_SV(tempsp->l4, L4_SZ), 0); + hv_store(self, "l5", 2, short_array_to_SV(tempsp->l5, L5_SZ), 0); + SAVE_INT32(self, tempsp, max); + SAVE_INT32(self, tempsp, min); + SAVE_INT32(self, tempsp, state); + SAVE_INT32(self, tempsp, temp_cnt); + SAVE_INT32(self, tempsp, shutdown_cnt); + SAVE_INT32(self, tempsp, version); + SAVE_INT32(self, tempsp, trend); + SAVE_INT32(self, tempsp, override); +} +#endif + +/* + * Not actually defined anywhere - just a short. Yuck. + */ + +#ifdef __sparc +static void +save_temp_over(HV *self, kstat_t *kp, int strip_str) +{ + short *shortp; + + /* PERL_ASSERT(kp->ks_ndata == 1); */ + PERL_ASSERT(kp->ks_data_size == sizeof (short)); + + shortp = (short *)(kp->ks_data); + hv_store(self, "override", 8, newSViv(*shortp), 0); +} +#endif + +/* + * Defined in /usr/platform/sun4u/include/sys/sysctrl.h + * (Well, sort of. Actually there's no structure, just a list of #defines + * enumerating *some* of the array indexes.) + */ + +#ifdef __sparc +static void +save_ps_shadow(HV *self, kstat_t *kp, int strip_str) +{ + uchar_t *ucharp; + + /* PERL_ASSERT(kp->ks_ndata == 1); */ + PERL_ASSERT(kp->ks_data_size == SYS_PS_COUNT); + + ucharp = (uchar_t *)(kp->ks_data); + hv_store(self, "core_0", 6, newSViv(*ucharp++), 0); + hv_store(self, "core_1", 6, newSViv(*ucharp++), 0); + hv_store(self, "core_2", 6, newSViv(*ucharp++), 0); + hv_store(self, "core_3", 6, newSViv(*ucharp++), 0); + hv_store(self, "core_4", 6, newSViv(*ucharp++), 0); + hv_store(self, "core_5", 6, newSViv(*ucharp++), 0); + hv_store(self, "core_6", 6, newSViv(*ucharp++), 0); + hv_store(self, "core_7", 6, newSViv(*ucharp++), 0); + hv_store(self, "pps_0", 5, newSViv(*ucharp++), 0); + hv_store(self, "clk_33", 6, newSViv(*ucharp++), 0); + hv_store(self, "clk_50", 6, newSViv(*ucharp++), 0); + hv_store(self, "v5_p", 4, newSViv(*ucharp++), 0); + hv_store(self, "v12_p", 5, newSViv(*ucharp++), 0); + hv_store(self, "v5_aux", 6, newSViv(*ucharp++), 0); + hv_store(self, "v5_p_pch", 8, newSViv(*ucharp++), 0); + hv_store(self, "v12_p_pch", 9, newSViv(*ucharp++), 0); + hv_store(self, "v3_pch", 6, newSViv(*ucharp++), 0); + hv_store(self, "v5_pch", 6, newSViv(*ucharp++), 0); + hv_store(self, "p_fan", 5, newSViv(*ucharp++), 0); +} +#endif + +/* + * Definition in /usr/platform/sun4u/include/sys/fhc.h + */ + +#ifdef __sparc +static void +save_fault_list(HV *self, kstat_t *kp, int strip_str) +{ + struct ft_list *faultp; + int i; + char name[KSTAT_STRLEN + 7]; /* room for 999999 faults */ + + /* PERL_ASSERT(kp->ks_ndata == 1); */ + /* PERL_ASSERT(kp->ks_data_size == sizeof (struct ft_list)); */ + + for (i = 1, faultp = (struct ft_list *)(kp->ks_data); + i <= 999999 && i <= kp->ks_data_size / sizeof (struct ft_list); + i++, faultp++) { + (void) snprintf(name, sizeof (name), "unit_%d", i); + hv_store(self, name, strlen(name), newSViv(faultp->unit), 0); + (void) snprintf(name, sizeof (name), "type_%d", i); + hv_store(self, name, strlen(name), newSViv(faultp->type), 0); + (void) snprintf(name, sizeof (name), "fclass_%d", i); + hv_store(self, name, strlen(name), newSViv(faultp->fclass), 0); + (void) snprintf(name, sizeof (name), "create_time_%d", i); + hv_store(self, name, strlen(name), + NEW_UV(faultp->create_time), 0); + (void) snprintf(name, sizeof (name), "msg_%d", i); + hv_store(self, name, strlen(name), newSVpv(faultp->msg, 0), 0); + } +} +#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 + * and/or name. This could be construed as a bug. However, to work around this + * 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 +build_raw_kstat_lookup() + { + /* Create new hash */ + raw_kstat_lookup = newHV(); + + SAVE_FNP(raw_kstat_lookup, save_cpu_stat, "cpu_stat:cpu_stat"); + SAVE_FNP(raw_kstat_lookup, save_var, "unix:var"); + SAVE_FNP(raw_kstat_lookup, save_ncstats, "unix:ncstats"); + SAVE_FNP(raw_kstat_lookup, save_sysinfo, "unix:sysinfo"); + SAVE_FNP(raw_kstat_lookup, save_vminfo, "unix:vminfo"); + SAVE_FNP(raw_kstat_lookup, save_nfs, "nfs:mntinfo"); +#ifdef __sparc + SAVE_FNP(raw_kstat_lookup, save_sfmmu_global_stat, + "unix:sfmmu_global_stat"); + SAVE_FNP(raw_kstat_lookup, save_sfmmu_tsbsize_stat, + "unix:sfmmu_tsbsize_stat"); + SAVE_FNP(raw_kstat_lookup, save_simmstat, "unix:simm-status"); + SAVE_FNP(raw_kstat_lookup, save_temperature, "unix:temperature"); + SAVE_FNP(raw_kstat_lookup, save_temp_over, "unix:temperature override"); + SAVE_FNP(raw_kstat_lookup, save_ps_shadow, "unix:ps_shadow"); + SAVE_FNP(raw_kstat_lookup, save_fault_list, "unix:fault_list"); +#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. + */ + +static kstat_raw_reader_t lookup_raw_kstat_fn(char *module, char *name) + { + char key[KSTAT_STRLEN * 2]; + register char *f, *t; + SV **entry; + kstat_raw_reader_t fnp; + + /* Copy across module & name, removing any digits - see comment above */ + for (f = module, t = key; *f != '\0'; f++, t++) { + 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 */ + if ((entry = hv_fetch(raw_kstat_lookup, key, strlen(key), FALSE)) == 0) + { + fnp = 0; + } else { + fnp = (kstat_raw_reader_t)(uintptr_t)SvIV(*entry); + } + 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 * +get_tie(SV *self, char *module, int instance, char *name, int *is_new) +{ + char str_inst[11]; /* big enough for up to 10^10 instances */ + char *key[3]; /* 3 part key: module, instance, name */ + int k; + int new; + HV *hash; + HV *tie; + + /* Create the keys */ + (void) snprintf(str_inst, sizeof (str_inst), "%d", instance); + key[0] = module; + key[1] = str_inst; + key[2] = name; + + /* Iteratively descend the tree, creating new hashes as required */ + hash = (HV *)SvRV(self); + for (k = 0; k < 3; k++) { + SV **entry; + + SvREADONLY_off(hash); + entry = hv_fetch(hash, key[k], strlen(key[k]), TRUE); + + /* If the entry doesn't exist, create it */ + if (! SvOK(*entry)) { + HV *newhash; + SV *rv; + + newhash = newHV(); + rv = newRV_noinc((SV *)newhash); + sv_setsv(*entry, rv); + SvREFCNT_dec(rv); + if (k < 2) { + SvREADONLY_on(newhash); + } + SvREADONLY_on(*entry); + SvREADONLY_on(hash); + hash = newhash; + new = 1; + + /* Otherwise it already existed */ + } else { + SvREADONLY_on(hash); + hash = (HV *)SvRV(*entry); + new = 0; + } + } + + /* Create and bless a hash for the tie, if necessary */ + if (new) { + SV *tieref; + HV *stash; + + tie = newHV(); + tieref = newRV_noinc((SV *)tie); + stash = gv_stashpv("Sun::Solaris::Kstat::_Stat", TRUE); + sv_bless(tieref, stash); + + /* Add TIEHASH magic */ + hv_magic(hash, (GV *)tieref, 'P'); + SvREADONLY_on(hash); + + /* Otherwise, just find the existing tied hash */ + } else { + MAGIC *mg; + + mg = mg_find((SV *)hash, 'P'); + PERL_ASSERTMSG(mg != 0, "get_tie: lost P magic"); + tie = (HV *)SvRV(mg->mg_obj); + } + if (is_new) { + *is_new = 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 +apply_to_ties(SV *self, ATTCb_t cb, void *arg) +{ + HV *hash1; + HE *entry1; + long s; + int ret; + + hash1 = (HV *)SvRV(self); + hv_iterinit(hash1); + ret = 1; + + /* Iterate over each module */ + while (entry1 = hv_iternext(hash1)) { + HV *hash2; + HE *entry2; + + hash2 = (HV *)SvRV(hv_iterval(hash1, entry1)); + hv_iterinit(hash2); + + /* Iterate over each module:instance */ + while (entry2 = hv_iternext(hash2)) { + HV *hash3; + HE *entry3; + + hash3 = (HV *)SvRV(hv_iterval(hash2, entry2)); + hv_iterinit(hash3); + + /* Iterate over each module:instance:name */ + while (entry3 = hv_iternext(hash3)) { + HV *hash4; + MAGIC *mg; + HV *tie; + + /* Get the tie */ + hash4 = (HV *)SvRV(hv_iterval(hash3, entry3)); + mg = mg_find((SV *)hash4, 'P'); + PERL_ASSERTMSG(mg != 0, + "apply_to_ties: lost P magic"); + + /* Apply the callback */ + if (! cb((HV *)SvRV(mg->mg_obj), arg)) { + ret = 0; + } + } + } + } + return (ret); +} + +/* + * Mark this HV as valid - used by update() when pruning deleted kstat nodes + */ + +static int +set_valid(HV *self, void *arg) +{ + MAGIC *mg; + + mg = mg_find((SV *)self, '~'); + PERL_ASSERTMSG(mg != 0, "set_valid: lost ~ magic"); + ((KstatInfo_t *)SvPVX(mg->mg_obj))->valid = (int)(intptr_t)arg; + 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 +prune_invalid(SV *self, AV *del) +{ + HV *hash1; + HE *entry1; + STRLEN klen; + char *module, *instance, *name, *key; + int ret; + + hash1 = (HV *)SvRV(self); + hv_iterinit(hash1); + ret = 0; + + /* Iterate over each module */ + while (entry1 = hv_iternext(hash1)) { + HV *hash2; + HE *entry2; + + module = HePV(entry1, PL_na); + hash2 = (HV *)SvRV(hv_iterval(hash1, entry1)); + hv_iterinit(hash2); + + /* Iterate over each module:instance */ + while (entry2 = hv_iternext(hash2)) { + HV *hash3; + HE *entry3; + + instance = HePV(entry2, PL_na); + hash3 = (HV *)SvRV(hv_iterval(hash2, entry2)); + hv_iterinit(hash3); + + /* Iterate over each module:instance:name */ + while (entry3 = hv_iternext(hash3)) { + HV *hash4; + MAGIC *mg; + HV *tie; + + name = HePV(entry3, PL_na); + hash4 = (HV *)SvRV(hv_iterval(hash3, entry3)); + mg = mg_find((SV *)hash4, 'P'); + PERL_ASSERTMSG(mg != 0, + "prune_invalid: lost P magic"); + tie = (HV *)SvRV(mg->mg_obj); + mg = mg_find((SV *)tie, '~'); + PERL_ASSERTMSG(mg != 0, + "prune_invalid: lost ~ magic"); + + /* If this is marked as invalid, prune it */ + if (((KstatInfo_t *)SvPVX( + (SV *)mg->mg_obj))->valid == FALSE) { + SvREADONLY_off(hash3); + key = HePV(entry3, klen); + hv_delete(hash3, key, klen, G_DISCARD); + SvREADONLY_on(hash3); + if (del) { + av_push(del, + newSVpvf("%s:%s:%s", + module, instance, name)); + } + ret = 1; + } + } + + /* If the module:instance:name hash is empty prune it */ + if (HvKEYS(hash3) == 0) { + SvREADONLY_off(hash2); + key = HePV(entry2, klen); + hv_delete(hash2, key, klen, G_DISCARD); + SvREADONLY_on(hash2); + } + } + /* If the module:instance hash is empty prune it */ + if (HvKEYS(hash2) == 0) { + SvREADONLY_off(hash1); + key = HePV(entry1, klen); + hv_delete(hash1, key, klen, G_DISCARD); + SvREADONLY_on(hash1); + } + } + return (ret); +} + +/* + * Named kstats are returned as a list of key/values. This function converts + * such a list into the equivalent perl datatypes, and stores them in the passed + * hash. + */ + +static void +save_named(HV *self, kstat_t *kp, int strip_str) +{ + kstat_named_t *knp; + int n; + SV* value; + + for (n = kp->ks_ndata, knp = KSTAT_NAMED_PTR(kp); n > 0; n--, knp++) { + switch (knp->data_type) { + case KSTAT_DATA_CHAR: + value = newSVpv(knp->value.c, strip_str ? + strlen(knp->value.c) : sizeof (knp->value.c)); + break; + case KSTAT_DATA_INT32: + value = newSViv(knp->value.i32); + break; + case KSTAT_DATA_UINT32: + value = NEW_UV(knp->value.ui32); + break; + case KSTAT_DATA_INT64: + value = NEW_UV(knp->value.i64); + break; + case KSTAT_DATA_UINT64: + value = NEW_UV(knp->value.ui64); + break; + case KSTAT_DATA_STRING: + if (KSTAT_NAMED_STR_PTR(knp) == NULL) + value = newSVpv("null", sizeof ("null") - 1); + else + value = newSVpv(KSTAT_NAMED_STR_PTR(knp), + KSTAT_NAMED_STR_BUFLEN(knp) -1); + break; + default: + PERL_ASSERTMSG(0, "kstat_read: invalid data type"); + break; + } + hv_store(self, knp->name, strlen(knp->name), value, 0); + } +} + +/* + * Save kstat interrupt statistics + */ + +static void +save_intr(HV *self, kstat_t *kp, int strip_str) +{ + kstat_intr_t *kintrp; + int i; + static char *intr_names[] = + { "hard", "soft", "watchdog", "spurious", "multiple_service" }; + + PERL_ASSERT(kp->ks_ndata == 1); + PERL_ASSERT(kp->ks_data_size == sizeof (kstat_intr_t)); + kintrp = KSTAT_INTR_PTR(kp); + + for (i = 0; i < KSTAT_NUM_INTRS; i++) { + hv_store(self, intr_names[i], strlen(intr_names[i]), + NEW_UV(kintrp->intrs[i]), 0); + } +} + +/* + * Save IO statistics + */ + +static void +save_io(HV *self, kstat_t *kp, int strip_str) +{ + kstat_io_t *kiop; + + PERL_ASSERT(kp->ks_ndata == 1); + PERL_ASSERT(kp->ks_data_size == sizeof (kstat_io_t)); + kiop = KSTAT_IO_PTR(kp); + SAVE_UINT64(self, kiop, nread); + SAVE_UINT64(self, kiop, nwritten); + SAVE_UINT32(self, kiop, reads); + SAVE_UINT32(self, kiop, writes); + SAVE_HRTIME(self, kiop, wtime); + SAVE_HRTIME(self, kiop, wlentime); + SAVE_HRTIME(self, kiop, wlastupdate); + SAVE_HRTIME(self, kiop, rtime); + SAVE_HRTIME(self, kiop, rlentime); + SAVE_HRTIME(self, kiop, rlastupdate); + SAVE_UINT32(self, kiop, wcnt); + SAVE_UINT32(self, kiop, rcnt); +} + +/* + * Save timer statistics + */ + +static void +save_timer(HV *self, kstat_t *kp, int strip_str) +{ + kstat_timer_t *ktimerp; + + PERL_ASSERT(kp->ks_ndata == 1); + PERL_ASSERT(kp->ks_data_size == sizeof (kstat_timer_t)); + ktimerp = KSTAT_TIMER_PTR(kp); + SAVE_STRING(self, ktimerp, name, strip_str); + SAVE_UINT64(self, ktimerp, num_events); + SAVE_HRTIME(self, ktimerp, elapsed_time); + SAVE_HRTIME(self, ktimerp, min_time); + SAVE_HRTIME(self, ktimerp, max_time); + SAVE_HRTIME(self, ktimerp, start_time); + SAVE_HRTIME(self, ktimerp, stop_time); +} + +/* + * 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 +read_kstats(HV *self, int refresh) +{ + MAGIC *mg; + KstatInfo_t *kip; + kstat_raw_reader_t fnp; + + /* Find the MAGIC KstatInfo_t data structure */ + mg = mg_find((SV *)self, '~'); + PERL_ASSERTMSG(mg != 0, "read_kstats: lost ~ magic"); + kip = (KstatInfo_t *)SvPVX(mg->mg_obj); + + /* Return early if we don't need to actually read the kstats */ + if ((refresh && ! kip->read) || (! refresh && kip->read)) { + return (1); + } + + /* Read the kstats and return 0 if this fails */ + if (kstat_read(kip->kstat_ctl, kip->kstat, NULL) < 0) { + return (0); + } + + /* Save the read data */ + hv_store(self, "snaptime", 8, NEW_HRTIME(kip->kstat->ks_snaptime), 0); + switch (kip->kstat->ks_type) { + case KSTAT_TYPE_RAW: + if ((fnp = lookup_raw_kstat_fn(kip->kstat->ks_module, + kip->kstat->ks_name)) != 0) { + fnp(self, kip->kstat, kip->strip_str); + } + break; + case KSTAT_TYPE_NAMED: + save_named(self, kip->kstat, kip->strip_str); + break; + case KSTAT_TYPE_INTR: + save_intr(self, kip->kstat, kip->strip_str); + break; + case KSTAT_TYPE_IO: + save_io(self, kip->kstat, kip->strip_str); + break; + case KSTAT_TYPE_TIMER: + save_timer(self, kip->kstat, kip->strip_str); + break; + default: + PERL_ASSERTMSG(0, "read_kstats: illegal kstat type"); + break; + } + kip->read = TRUE; + 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 */ + +MODULE = Sun::Solaris::Kstat PACKAGE = Sun::Solaris::Kstat +PROTOTYPES: ENABLE + + # Create the raw kstat to store function lookup table on load +BOOT: + build_raw_kstat_lookup(); + + # + # The Sun::Solaris::Kstat constructor. This builds the nested + # name::instance::module hash structure, but doesn't actually read the + # 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; + + /* Don't bother storing the kstat headers */ + if (strncmp(kp->ks_name, "kstat_", 6) == 0) { + continue; + } + + /* Don't bother storing raw stats we don't understand */ + if (kp->ks_type == KSTAT_TYPE_RAW && + lookup_raw_kstat_fn(kp->ks_module, kp->ks_name) == 0) { +#ifdef REPORT_UNKNOWN + (void) fprintf(stderr, + "Unknown kstat type %s:%d:%s - %d of size %d\n", + kp->ks_module, kp->ks_instance, kp->ks_name, + kp->ks_ndata, kp->ks_data_size); +#endif + continue; + } + + /* Create a 3-layer hash hierarchy - module.instance.name */ + tie = get_tie(RETVAL, kp->ks_module, kp->ks_instance, + kp->ks_name, 0); + + /* Save the data necessary to read the kstat info on demand */ + hv_store(tie, "class", 5, newSVpv(kp->ks_class, 0), 0); + hv_store(tie, "crtime", 6, NEW_HRTIME(kp->ks_crtime), 0); + kstatinfo.kstat = kp; + kstatsv = newSVpv((char *)&kstatinfo, sizeof (kstatinfo)); + sv_magic((SV *)tie, kstatsv, '~', 0, 0); + SvREFCNT_dec(kstatsv); + } + SvREADONLY_on(SvRV(RETVAL)); + /* SvREADONLY_on(RETVAL); */ +OUTPUT: + RETVAL + + # + # Update the perl hash structure so that it is in line with the kernel kstats + # data. Only kstats athat have previously been accessed are read, + # + + # Scalar context: true/false + # Array context: (\@added, \@deleted) +void +update(self) + SV* self; +PREINIT: + MAGIC *mg; + kstat_ctl_t *kc; + kstat_t *kp; + int ret; + AV *add, *del; +PPCODE: + /* Find the hidden KstatInfo_t structure */ + mg = mg_find(SvRV(self), '~'); + PERL_ASSERTMSG(mg != 0, "update: lost ~ magic"); + kc = *(kstat_ctl_t **)SvPVX(mg->mg_obj); + + /* Update the kstat chain, and return immediately on error. */ + if ((ret = kstat_chain_update(kc)) == -1) { + if (GIMME_V == G_ARRAY) { + EXTEND(SP, 2); + PUSHs(sv_newmortal()); + PUSHs(sv_newmortal()); + } else { + EXTEND(SP, 1); + PUSHs(sv_2mortal(newSViv(ret))); + } + } + + /* Create the arrays to be returned if in an array context */ + if (GIMME_V == G_ARRAY) { + add = newAV(); + del = newAV(); + } 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) { + if (! apply_to_ties(self, (ATTCb_t)read_kstats, (void *)TRUE)) { + if (GIMME_V == G_ARRAY) { + EXTEND(SP, 2); + PUSHs(sv_2mortal(newRV_noinc((SV *)add))); + PUSHs(sv_2mortal(newRV_noinc((SV *)del))); + } else { + EXTEND(SP, 1); + PUSHs(sv_2mortal(newSViv(-1))); + } + } + + /* + * 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 { + KstatInfo_t kstatinfo; + + /* + * Step 1: set the 'invalid' flag on each entry + */ + apply_to_ties(self, &set_valid, (void *)FALSE); + + /* + * Step 2: Set the 'valid' flag on all entries still in the + * kernel kstat chain + */ + kstatinfo.read = FALSE; + kstatinfo.valid = TRUE; + kstatinfo.kstat_ctl = kc; + for (kp = kc->kc_chain; kp != 0; kp = kp->ks_next) { + int new; + HV *tie; + + /* Don't bother storing the kstat headers or types */ + if (strncmp(kp->ks_name, "kstat_", 6) == 0) { + continue; + } + + /* Don't bother storing raw stats we don't understand */ + if (kp->ks_type == KSTAT_TYPE_RAW && + lookup_raw_kstat_fn(kp->ks_module, kp->ks_name) + == 0) { +#ifdef REPORT_UNKNOWN + (void) printf("Unknown kstat type %s:%d:%s " + "- %d of size %d\n", kp->ks_module, + kp->ks_instance, kp->ks_name, + kp->ks_ndata, kp->ks_data_size); +#endif + continue; + } + + /* Find the tied hash associated with the kstat entry */ + tie = get_tie(self, kp->ks_module, kp->ks_instance, + kp->ks_name, &new); + + /* If newly created store the associated kstat info */ + if (new) { + SV *kstatsv; + + /* + * Save the data necessary to read the kstat + * info on demand + */ + hv_store(tie, "class", 5, + newSVpv(kp->ks_class, 0), 0); + hv_store(tie, "crtime", 6, + NEW_HRTIME(kp->ks_crtime), 0); + kstatinfo.kstat = kp; + kstatsv = newSVpv((char *)&kstatinfo, + sizeof (kstatinfo)); + sv_magic((SV *)tie, kstatsv, '~', 0, 0); + SvREFCNT_dec(kstatsv); + + /* Save the key on the add list, if required */ + if (GIMME_V == G_ARRAY) { + av_push(add, newSVpvf("%s:%d:%s", + kp->ks_module, kp->ks_instance, + kp->ks_name)); + } + + /* If the stats already exist, just update them */ + } else { + MAGIC *mg; + KstatInfo_t *kip; + + /* Find the hidden KstatInfo_t */ + mg = mg_find((SV *)tie, '~'); + PERL_ASSERTMSG(mg != 0, "update: lost ~ magic"); + kip = (KstatInfo_t *)SvPVX(mg->mg_obj); + + /* Mark the tie as valid */ + kip->valid = TRUE; + + /* 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. + */ + kip->kstat = kp; + + /* Reread the stats, if read previously */ + read_kstats(tie, TRUE); + } + } + + /* + *Step 3: Delete any entries still marked as 'invalid' + */ + ret = prune_invalid(self, del); + + } + if (GIMME_V == G_ARRAY) { + EXTEND(SP, 2); + PUSHs(sv_2mortal(newRV_noinc((SV *)add))); + PUSHs(sv_2mortal(newRV_noinc((SV *)del))); + } else { + EXTEND(SP, 1); + PUSHs(sv_2mortal(newSViv(ret))); + } + + + # + # Destructor. Closes the kstat connection + # + +void +DESTROY(self) + SV *self; +PREINIT: + MAGIC *mg; + kstat_ctl_t *kc; +CODE: + mg = mg_find(SvRV(self), '~'); + PERL_ASSERTMSG(mg != 0, "DESTROY: lost ~ magic"); + kc = *(kstat_ctl_t **)SvPVX(mg->mg_obj); + if (kstat_close(kc) != 0) { + croak(DEBUG_ID ": kstat_close: failed"); + } + + # + # The following XS methods implement the TIEHASH mechanism used to update the + # kstats hash structure. These are blessed into a package that isn't + # 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); diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..152b3b3 --- /dev/null +++ b/META.yml @@ -0,0 +1,20 @@ +--- #YAML:1.0 +name: Sun-Solaris-Kstat +version: 1.3 +abstract: ~ +author: [] +license: unknown +distribution_type: module +configure_requires: + ExtUtils::MakeMaker: 0 +build_requires: + ExtUtils::MakeMaker: 0 +requires: {} +no_index: + directory: + - t + - inc +generated_by: ExtUtils::MakeMaker version 6.57_05 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..386d8c4 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,60 @@ +# +# 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 +# or http://www.opensolaris.org/os/licensing. +# 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 2007 Sun Microsystems, Inc. All rights reserved. +# Use is subject to license terms. +# +# ident "%Z%%M% %I% %E% SMI" +# + +use ExtUtils::MakeMaker; +my ($defines, $includes) = ('', ''); + +# Uncomment this to turn on assertions +#$defines .= '-DKSTAT_DEBUG '; + +# Uncomment this to report unknown binary kstats +#$defines .= '-DREPORT_UNKNOWN '; + +# +# Because there are still platform specific raw kstats, we need to include the +# platform specific header files, so work out where they live. +# +my $arch = qx{uname -p}; chomp($arch); +if ($arch eq 'sparc') { + $includes .= '-I/usr/platform/sun4u/include' . + ' -I/usr/platform/sun4v/include'; +} elsif ($arch eq 'i386') { + $includes .= '-I/usr/platform/i86pc/include' . + ' -I/usr/platform/i86xpv/include'; +} else { + die("Unknown architecture $arch\n"); +} + +WriteMakefile( + NAME => 'Sun::Solaris::Kstat', + VERSION_FROM => 'Kstat.pm', + LIBS => [ '-lkstat' ], + DEFINE => $defines, + INC => $includes, + OBJECT => '$(O_FILES)', +); diff --git a/t/Kstat.t b/t/Kstat.t new file mode 100644 index 0000000..8d1f92c --- /dev/null +++ b/t/Kstat.t @@ -0,0 +1,177 @@ +# +# Copyright 2005 Sun Microsystems, Inc. All rights reserved. +# Use is subject to license terms. +# +# CDDL HEADER START +# +# The contents of this file are subject to the terms of the +# Common Development and Distribution License, Version 1.0 only +# (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 +# or http://www.opensolaris.org/os/licensing. +# 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 +# +#ident "%Z%%M% %I% %E% SMI" +# +# test script for Sun::Solaris::Kstat +# + +use strict; + +# Visit all the leaf nodes - +# will generate a die if there are any structure mismatches +sub visit_all($) +{ + my ($ks) = @_; + foreach my $m (sort(keys(%$ks))) { + foreach my $i (sort(keys(%{$ks->{$m}}))) { + foreach my $n (sort(keys(%{$ks->{$m}->{$i}}))) { + foreach my $k (sort( + keys(%{$ks->{$m}->{$i}->{$n}}))) { + my $v = $ks->{$m}->{$i}->{$n}->{$k}; + } + } + } + } + return(1); +} + +BEGIN { $| = 1; print "1..15\n"; } +my $loaded; +END {print "not ok 1\n" unless $loaded;} +use Sun::Solaris::Kstat; +$loaded = 1; +print "ok 1\n"; + +# Check we can create a Kstat object OK +my ($test, $ks); +$test = 2; +if (! eval { $ks = Sun::Solaris::Kstat->new() }) { + print("not ok $test: $@"); +} else { + print("ok $test\n"); +} +$test++; + +# Check FIRSTKEY/NEXTKEY/FETCH and for structure mismatches +if (! eval { visit_all($ks) }) { + print("not ok $test: $@"); +} else { + print("ok $test\n"); +} +$test++; + +# Find a cpu number +my $cpu = (keys(%{$ks->{cpu_info}}))[0]; +my $cpu_info = "cpu_info$cpu"; + +# Check EXISTS +if (exists($ks->{cpu_info}{$cpu}{$cpu_info}{state})) { + print("ok $test\n"); +} else { + print("not ok $test\n"); +} +$test++; + +# Check DELETE +my $val = delete($ks->{cpu_info}{$cpu}{$cpu_info}{state}); +if (defined($val) && ($val =~ /^on-line/ || $val =~ /^off-line/)) { + print("ok $test\n"); +} else { + print("not ok $test ($val)\n"); +} +$test++; + +# 5.004_04 has a broken hv_delete +if ($] < 5.00405) { + print("ok $test\n"); + $test++; + print("ok $test\n"); + $test++; +} else { + if (! exists($ks->{cpu_info}{$cpu}{$cpu_info}{state})) { + print("ok $test\n"); + } else { + print("not ok $test\n"); + } + $test++; + $val = $ks->{cpu_info}{$cpu}{$cpu_info}{state}; + if (! defined($val)) { + print("ok $test\n"); + } else { + print("not ok $test\n"); + } + $test++; +} + +# Check STORE +$ks->{cpu_info}{$cpu}{$cpu_info}{state} = "california"; +if ($ks->{cpu_info}{$cpu}{$cpu_info}{state} eq "california") { + print("ok $test\n"); +} else { + print("not ok $test\n"); +} +$test++; + +# Check CLEAR +my @bvals = sort(keys(%{$ks->{cpu_info}{$cpu}{$cpu_info}})); +%{$ks->{cpu_info}{$cpu}{$cpu_info}} = (); +my @avals = sort(keys(%{$ks->{cpu_info}{$cpu}{$cpu_info}})); +while (@bvals || @avals) { + my $a = shift(@avals); + my $b = shift(@bvals); + if ($a ne $b) { print("not ok $test ($a ne $b)\n"); last; } +} +print("ok $test\n") if (! @avals && ! @bvals); +$test++; + +# Check updates +if (! defined(eval { $ks->update() })) { + print("not ok $test: $@"); +} else { + print("ok $test\n"); +} +$test++; + +# Check readonly-ness of hash structure +eval { $ks->{cpu_info}{$cpu}{$cpu_info} = {}; }; +print($@ =~ /^Modification of a read-only/i ? "ok $test\n" : "not ok $test\n"); +$test++; + +eval { $ks->{cpu_info}{$cpu} = {}; }; +print($@ =~ /^Modification of a read-only/i ? "ok $test\n" : "not ok $test\n"); +$test++; + +eval { $ks->{cpu_info} = {}; }; +print($@ =~ /^Modification of a read-only/i ? "ok $test\n" : "not ok $test\n"); +$test++; + +# Check timestamps +my $then = $ks->{cpu_info}{$cpu}{$cpu_info}{snaptime}; +sleep(3); +if (! defined(eval { $ks->update() })) { + print("not ok $test: $@"); +} else { + print("ok $test\n"); +} +$test++; +my $interval = $ks->{cpu_info}{$cpu}{$cpu_info}{snaptime} - $then; +if ($interval >= 2.5 && $interval <= 3.5) { + print("ok $test\n"); +} else { + print("not ok $test\n"); +} +$test++; + +exit(0); |