usr/src/cmd/perl/contrib/Sun/Solaris/Kstat/Kstat.xs

   1 /*
   2  * CDDL HEADER START
   3  *
   4  * The contents of this file are subject to the terms of the
   5  * Common Development and Distribution License (the "License").
   6  * You may not use this file except in compliance with the License.
   7  *
   8  * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
   9  * or http://www.opensolaris.org/os/licensing.
  10  * See the License for the specific language governing permissions
  11  * and limitations under the License.
  12  *
  13  * When distributing Covered Code, include this CDDL HEADER in each
  14  * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
  15  * If applicable, add the following below this CDDL HEADER, with the
  16  * fields enclosed by brackets "[]" replaced with your own identifying
  17  * information: Portions Copyright [yyyy] [name of copyright owner]
  18  *
  19  * CDDL HEADER END
  20  */
  21
  22 /*
  23  * Copyright (c) 1999, 2010, Oracle and/or its affiliates. All rights reserved.
  24  * Copyright (c) 2014 Racktop Systems.
  25  */
  26
  27 /*
  28  * Kstat.xs is a Perl XS (eXStension module) that makes the Solaris
  29  * kstat(3KSTAT) facility available to Perl scripts.  Kstat is a general-purpose
  30  * mechanism  for  providing kernel statistics to users.  The Solaris API is
  31  * function-based (see the manpage for details), but for ease of use in Perl
  32  * scripts this module presents the information as a nested hash data structure.
  33  * It would be too inefficient to read every kstat in the system, so this module
  34  * uses the Perl TIEHASH mechanism to implement a read-on-demand semantic, which
  35  * only reads and updates kstats as and when they are actually accessed.
  36  */
  37
  38 /*
  39  * Ignored raw kstats.
  40  *
  41  * Some raw kstats are ignored by this module, these are listed below.  The
  42  * most common reason is that the kstats are stored as arrays and the ks_ndata
  43  * and/or ks_data_size fields are invalid.  In this case it is impossible to
  44  * know how many records are in the array, so they can't be read.
  45  *
  46  * unix:*:sfmmu_percpu_stat
  47  * This is stored as an array with one entry per cpu.  Each element is of type
  48  * struct sfmmu_percpu_stat.  The ks_ndata and ks_data_size fields are bogus.
  49  *
  50  * ufs directio:*:UFS DirectIO Stats
  51  * The structure definition used for these kstats (ufs_directio_kstats) is in a
  52  * C file (uts/common/fs/ufs/ufs_directio.c) rather than a header file, so it
  53  * isn't accessible.
  54  *
  55  * qlc:*:statistics
  56  * This is a third-party driver for which we don't have source.
  57  *
  58  * mm:*:phys_installed
  59  * This is stored as an array of uint64_t, with each pair of values being the
  60  * (address, size) of a memory segment.  The ks_ndata and ks_data_size fields
  61  * are both zero.
  62  *
  63  * sockfs:*:sock_unix_list
  64  * This is stored as an array with one entry per active socket.  Each element
  65  * is of type struct k_sockinfo.  The ks_ndata and ks_data_size fields are both
  66  * zero.
  67  *
  68  * Note that the ks_ndata and ks_data_size of many non-array raw kstats are
  69  * also incorrect.  The relevant assertions are therefore commented out in the
  70  * appropriate raw kstat read routines.
  71  */
  72
  73 /* Kstat related includes */
  74 #include <libgen.h>
  75 #include <kstat.h>
  76 #include <sys/var.h>
  77 #include <sys/utsname.h>
  78 #include <sys/sysinfo.h>
  79 #include <sys/flock.h>
  80 #include <sys/dnlc.h>
  81 #include <nfs/nfs.h>
  82 #include <nfs/nfs_clnt.h>
  83
  84 /* Ultra-specific kstat includes */
  85
  86 /*
  87  * Solaris #defines SP, which conflicts with the perl definition of SP
  88  * We don't need the Solaris one, so get rid of it to avoid warnings
  89  */
  90 #undef SP
  91
  92 /* Perl XS includes */
  93 #include "EXTERN.h"
  94 #include "perl.h"
  95 #include "XSUB.h"
  96
  97 /* Debug macros */
  98 #define DEBUG_ID "Sun::Solaris::Kstat"
  99 #ifdef KSTAT_DEBUG
 100 #define PERL_ASSERT(EXP) \
 101     ((void)((EXP) || (croak("%s: assertion failed at %s:%d: %s", \
 102     DEBUG_ID, __FILE__, __LINE__, #EXP), 0), 0))
 103 #define PERL_ASSERTMSG(EXP, MSG) \
 104     ((void)((EXP) || (croak(DEBUG_ID ": " MSG), 0), 0))
 105 #else
 106 #define PERL_ASSERT(EXP)                ((void)0)
 107 #define PERL_ASSERTMSG(EXP, MSG)        ((void)0)
 108 #endif
 109
 110 /* Macros for saving the contents of KSTAT_RAW structures */
 111 #if defined(HAS_QUAD) && defined(USE_64_BIT_INT)
 112 #define NEW_IV(V) \
 113     (newSViv((IVTYPE) V))
 114 #define NEW_UV(V) \
 115     (newSVuv((UVTYPE) V))
 116 #else
 117 #define NEW_IV(V) \
 118     (V >= IV_MIN && V <= IV_MAX ? newSViv((IVTYPE) V) : newSVnv((NVTYPE) V))
 119 #if defined(UVTYPE)
 120 #define NEW_UV(V) \
 121     (V <= UV_MAX ? newSVuv((UVTYPE) V) : newSVnv((NVTYPE) V))
 122 # else
 123 #define NEW_UV(V) \
 124     (V <= IV_MAX ? newSViv((IVTYPE) V) : newSVnv((NVTYPE) V))
 125 #endif
 126 #endif
 127 #define NEW_HRTIME(V) \
 128     newSVnv((NVTYPE) (V / 1000000000.0))
 129
 130 #define SAVE_FNP(H, F, K) \
 131     hv_store(H, K, sizeof (K) - 1, newSViv((IVTYPE)(uintptr_t)&F), 0)
 132 #define SAVE_STRING(H, S, K, SS) \
 133     hv_store(H, #K, sizeof (#K) - 1, \
 134     newSVpvn(S->K, SS ? strlen(S->K) : sizeof(S->K)), 0)
 135 #define SAVE_INT32(H, S, K) \
 136     hv_store(H, #K, sizeof (#K) - 1, NEW_IV(S->K), 0)
 137 #define SAVE_UINT32(H, S, K) \
 138     hv_store(H, #K, sizeof (#K) - 1, NEW_UV(S->K), 0)
 139 #define SAVE_INT64(H, S, K) \
 140     hv_store(H, #K, sizeof (#K) - 1, NEW_IV(S->K), 0)
 141 #define SAVE_UINT64(H, S, K) \
 142     hv_store(H, #K, sizeof (#K) - 1, NEW_UV(S->K), 0)
 143 #define SAVE_HRTIME(H, S, K) \
 144     hv_store(H, #K, sizeof (#K) - 1, NEW_HRTIME(S->K), 0)
 145
 146 /* Private structure used for saving kstat info in the tied hashes */
 147 typedef struct {
 148         char            read;           /* Kstat block has been read before */
 149         char            valid;          /* Kstat still exists in kstat chain */
 150         char            strip_str;      /* Strip KSTAT_DATA_CHAR fields */
 151         kstat_ctl_t     *kstat_ctl;     /* Handle returned by kstat_open */
 152         kstat_t         *kstat;         /* Handle used by kstat_read */
 153 } KstatInfo_t;
 154
 155 /* typedef for apply_to_ties callback functions */
 156 typedef int (*ATTCb_t)(HV *, void *);
 157
 158 /* typedef for raw kstat reader functions */
 159 typedef void (*kstat_raw_reader_t)(HV *, kstat_t *, int);
 160
 161 /* Hash of "module:name" to KSTAT_RAW read functions */
 162 static HV *raw_kstat_lookup;
 163
 164 /*
 165  * Kstats come in two flavours, named and raw.  Raw kstats are just C structs,
 166  * so we need a function per raw kstat to convert the C struct into the
 167  * corresponding perl hash.  All such conversion functions are in the following
 168  * section.
 169  */
 170
 171 /*
 172  * Definitions in /usr/include/sys/cpuvar.h and /usr/include/sys/sysinfo.h
 173  */
 174
 175 static void
 176 save_cpu_stat(HV *self, kstat_t *kp, int strip_str)
 177 {
 178         cpu_stat_t    *statp;
 179         cpu_sysinfo_t *sysinfop;
 180         cpu_syswait_t *syswaitp;
 181         cpu_vminfo_t  *vminfop;
 182
 183         /* PERL_ASSERT(kp->ks_ndata == 1); */
 184         PERL_ASSERT(kp->ks_data_size == sizeof (cpu_stat_t));
 185         statp = (cpu_stat_t *)(kp->ks_data);
 186         sysinfop = &statp->cpu_sysinfo;
 187         syswaitp = &statp->cpu_syswait;
 188         vminfop  = &statp->cpu_vminfo;
 189
 190         hv_store(self, "idle", 4, NEW_UV(sysinfop->cpu[CPU_IDLE]), 0);
 191         hv_store(self, "user", 4, NEW_UV(sysinfop->cpu[CPU_USER]), 0);
 192         hv_store(self, "kernel", 6, NEW_UV(sysinfop->cpu[CPU_KERNEL]), 0);
 193         hv_store(self, "wait", 4, NEW_UV(sysinfop->cpu[CPU_WAIT]), 0);
 194         hv_store(self, "wait_io", 7, NEW_UV(sysinfop->wait[W_IO]), 0);
 195         hv_store(self, "wait_swap", 9, NEW_UV(sysinfop->wait[W_SWAP]), 0);
 196         hv_store(self, "wait_pio",  8, NEW_UV(sysinfop->wait[W_PIO]), 0);
 197         SAVE_UINT32(self, sysinfop, bread);
 198         SAVE_UINT32(self, sysinfop, bwrite);
 199         SAVE_UINT32(self, sysinfop, lread);
 200         SAVE_UINT32(self, sysinfop, lwrite);
 201         SAVE_UINT32(self, sysinfop, phread);
 202         SAVE_UINT32(self, sysinfop, phwrite);
 203         SAVE_UINT32(self, sysinfop, pswitch);
 204         SAVE_UINT32(self, sysinfop, trap);
 205         SAVE_UINT32(self, sysinfop, intr);
 206         SAVE_UINT32(self, sysinfop, syscall);
 207         SAVE_UINT32(self, sysinfop, sysread);
 208         SAVE_UINT32(self, sysinfop, syswrite);
 209         SAVE_UINT32(self, sysinfop, sysfork);
 210         SAVE_UINT32(self, sysinfop, sysvfork);
 211         SAVE_UINT32(self, sysinfop, sysexec);
 212         SAVE_UINT32(self, sysinfop, readch);
 213         SAVE_UINT32(self, sysinfop, writech);
 214         SAVE_UINT32(self, sysinfop, rcvint);
 215         SAVE_UINT32(self, sysinfop, xmtint);
 216         SAVE_UINT32(self, sysinfop, mdmint);
 217         SAVE_UINT32(self, sysinfop, rawch);
 218         SAVE_UINT32(self, sysinfop, canch);
 219         SAVE_UINT32(self, sysinfop, outch);
 220         SAVE_UINT32(self, sysinfop, msg);
 221         SAVE_UINT32(self, sysinfop, sema);
 222         SAVE_UINT32(self, sysinfop, namei);
 223         SAVE_UINT32(self, sysinfop, ufsiget);
 224         SAVE_UINT32(self, sysinfop, ufsdirblk);
 225         SAVE_UINT32(self, sysinfop, ufsipage);
 226         SAVE_UINT32(self, sysinfop, ufsinopage);
 227         SAVE_UINT32(self, sysinfop, inodeovf);
 228         SAVE_UINT32(self, sysinfop, fileovf);
 229         SAVE_UINT32(self, sysinfop, procovf);
 230         SAVE_UINT32(self, sysinfop, intrthread);
 231         SAVE_UINT32(self, sysinfop, intrblk);
 232         SAVE_UINT32(self, sysinfop, idlethread);
 233         SAVE_UINT32(self, sysinfop, inv_swtch);
 234         SAVE_UINT32(self, sysinfop, nthreads);
 235         SAVE_UINT32(self, sysinfop, cpumigrate);
 236         SAVE_UINT32(self, sysinfop, xcalls);
 237         SAVE_UINT32(self, sysinfop, mutex_adenters);
 238         SAVE_UINT32(self, sysinfop, rw_rdfails);
 239         SAVE_UINT32(self, sysinfop, rw_wrfails);
 240         SAVE_UINT32(self, sysinfop, modload);
 241         SAVE_UINT32(self, sysinfop, modunload);
 242         SAVE_UINT32(self, sysinfop, bawrite);
 243 #ifdef STATISTICS       /* see header file */
 244         SAVE_UINT32(self, sysinfop, rw_enters);
 245         SAVE_UINT32(self, sysinfop, win_uo_cnt);
 246         SAVE_UINT32(self, sysinfop, win_uu_cnt);
 247         SAVE_UINT32(self, sysinfop, win_so_cnt);
 248         SAVE_UINT32(self, sysinfop, win_su_cnt);
 249         SAVE_UINT32(self, sysinfop, win_suo_cnt);
 250 #endif
 251
 252         SAVE_INT32(self, syswaitp, iowait);
 253         SAVE_INT32(self, syswaitp, swap);
 254         SAVE_INT32(self, syswaitp, physio);
 255
 256         SAVE_UINT32(self, vminfop, pgrec);
 257         SAVE_UINT32(self, vminfop, pgfrec);
 258         SAVE_UINT32(self, vminfop, pgin);
 259         SAVE_UINT32(self, vminfop, pgpgin);
 260         SAVE_UINT32(self, vminfop, pgout);
 261         SAVE_UINT32(self, vminfop, pgpgout);
 262         SAVE_UINT32(self, vminfop, swapin);
 263         SAVE_UINT32(self, vminfop, pgswapin);
 264         SAVE_UINT32(self, vminfop, swapout);
 265         SAVE_UINT32(self, vminfop, pgswapout);
 266         SAVE_UINT32(self, vminfop, zfod);
 267         SAVE_UINT32(self, vminfop, dfree);
 268         SAVE_UINT32(self, vminfop, scan);
 269         SAVE_UINT32(self, vminfop, rev);
 270         SAVE_UINT32(self, vminfop, hat_fault);
 271         SAVE_UINT32(self, vminfop, as_fault);
 272         SAVE_UINT32(self, vminfop, maj_fault);
 273         SAVE_UINT32(self, vminfop, cow_fault);
 274         SAVE_UINT32(self, vminfop, prot_fault);
 275         SAVE_UINT32(self, vminfop, softlock);
 276         SAVE_UINT32(self, vminfop, kernel_asflt);
 277         SAVE_UINT32(self, vminfop, pgrrun);
 278         SAVE_UINT32(self, vminfop, execpgin);
 279         SAVE_UINT32(self, vminfop, execpgout);
 280         SAVE_UINT32(self, vminfop, execfree);
 281         SAVE_UINT32(self, vminfop, anonpgin);
 282         SAVE_UINT32(self, vminfop, anonpgout);
 283         SAVE_UINT32(self, vminfop, anonfree);
 284         SAVE_UINT32(self, vminfop, fspgin);
 285         SAVE_UINT32(self, vminfop, fspgout);
 286         SAVE_UINT32(self, vminfop, fsfree);
 287 }
 288
 289 /*
 290  * Definitions in /usr/include/sys/var.h
 291  */
 292
 293 static void
 294 save_var(HV *self, kstat_t *kp, int strip_str)
 295 {
 296         struct var *varp;
 297
 298         /* PERL_ASSERT(kp->ks_ndata == 1); */
 299         PERL_ASSERT(kp->ks_data_size == sizeof (struct var));
 300         varp = (struct var *)(kp->ks_data);
 301
 302         SAVE_INT32(self, varp, v_buf);
 303         SAVE_INT32(self, varp, v_call);
 304         SAVE_INT32(self, varp, v_proc);
 305         SAVE_INT32(self, varp, v_maxupttl);
 306         SAVE_INT32(self, varp, v_nglobpris);
 307         SAVE_INT32(self, varp, v_maxsyspri);
 308         SAVE_INT32(self, varp, v_clist);
 309         SAVE_INT32(self, varp, v_maxup);
 310         SAVE_INT32(self, varp, v_hbuf);
 311         SAVE_INT32(self, varp, v_hmask);
 312         SAVE_INT32(self, varp, v_pbuf);
 313         SAVE_INT32(self, varp, v_sptmap);
 314         SAVE_INT32(self, varp, v_maxpmem);
 315         SAVE_INT32(self, varp, v_autoup);
 316         SAVE_INT32(self, varp, v_bufhwm);
 317 }
 318
 319 /*
 320  * Definition in /usr/include/sys/dnlc.h
 321  */
 322
 323 static void
 324 save_ncstats(HV *self, kstat_t *kp, int strip_str)
 325 {
 326         struct ncstats *ncstatsp;
 327
 328         /* PERL_ASSERT(kp->ks_ndata == 1); */
 329         PERL_ASSERT(kp->ks_data_size == sizeof (struct ncstats));
 330         ncstatsp = (struct ncstats *)(kp->ks_data);
 331
 332         SAVE_INT32(self, ncstatsp, hits);
 333         SAVE_INT32(self, ncstatsp, misses);
 334         SAVE_INT32(self, ncstatsp, enters);
 335         SAVE_INT32(self, ncstatsp, dbl_enters);
 336         SAVE_INT32(self, ncstatsp, long_enter);
 337         SAVE_INT32(self, ncstatsp, long_look);
 338         SAVE_INT32(self, ncstatsp, move_to_front);
 339         SAVE_INT32(self, ncstatsp, purges);
 340 }
 341
 342 /*
 343  * Definition in  /usr/include/sys/sysinfo.h
 344  */
 345
 346 static void
 347 save_sysinfo(HV *self, kstat_t *kp, int strip_str)
 348 {
 349         sysinfo_t *sysinfop;
 350
 351         /* PERL_ASSERT(kp->ks_ndata == 1); */
 352         PERL_ASSERT(kp->ks_data_size == sizeof (sysinfo_t));
 353         sysinfop = (sysinfo_t *)(kp->ks_data);
 354
 355         SAVE_UINT32(self, sysinfop, updates);
 356         SAVE_UINT32(self, sysinfop, runque);
 357         SAVE_UINT32(self, sysinfop, runocc);
 358         SAVE_UINT32(self, sysinfop, swpque);
 359         SAVE_UINT32(self, sysinfop, swpocc);
 360         SAVE_UINT32(self, sysinfop, waiting);
 361 }
 362
 363 /*
 364  * Definition in  /usr/include/sys/sysinfo.h
 365  */
 366
 367 static void
 368 save_vminfo(HV *self, kstat_t *kp, int strip_str)
 369 {
 370         vminfo_t *vminfop;
 371
 372         /* PERL_ASSERT(kp->ks_ndata == 1); */
 373         PERL_ASSERT(kp->ks_data_size == sizeof (vminfo_t));
 374         vminfop = (vminfo_t *)(kp->ks_data);
 375
 376         SAVE_UINT64(self, vminfop, freemem);
 377         SAVE_UINT64(self, vminfop, swap_resv);
 378         SAVE_UINT64(self, vminfop, swap_alloc);
 379         SAVE_UINT64(self, vminfop, swap_avail);
 380         SAVE_UINT64(self, vminfop, swap_free);
 381         SAVE_UINT64(self, vminfop, updates);
 382 }
 383
 384 /*
 385  * Definition in /usr/include/nfs/nfs_clnt.h
 386  */
 387
 388 static void
 389 save_nfs(HV *self, kstat_t *kp, int strip_str)
 390 {
 391         struct mntinfo_kstat *mntinfop;
 392
 393         /* PERL_ASSERT(kp->ks_ndata == 1); */
 394         PERL_ASSERT(kp->ks_data_size == sizeof (struct mntinfo_kstat));
 395         mntinfop = (struct mntinfo_kstat *)(kp->ks_data);
 396
 397         SAVE_STRING(self, mntinfop, mik_proto, strip_str);
 398         SAVE_UINT32(self, mntinfop, mik_vers);
 399         SAVE_UINT32(self, mntinfop, mik_flags);
 400         SAVE_UINT32(self, mntinfop, mik_secmod);
 401         SAVE_UINT32(self, mntinfop, mik_curread);
 402         SAVE_UINT32(self, mntinfop, mik_curwrite);
 403         SAVE_INT32(self, mntinfop, mik_timeo);
 404         SAVE_INT32(self, mntinfop, mik_retrans);
 405         SAVE_UINT32(self, mntinfop, mik_acregmin);
 406         SAVE_UINT32(self, mntinfop, mik_acregmax);
 407         SAVE_UINT32(self, mntinfop, mik_acdirmin);
 408         SAVE_UINT32(self, mntinfop, mik_acdirmax);
 409         hv_store(self, "lookup_srtt", 11,
 410             NEW_UV(mntinfop->mik_timers[0].srtt), 0);
 411         hv_store(self, "lookup_deviate", 14,
 412             NEW_UV(mntinfop->mik_timers[0].deviate), 0);
 413         hv_store(self, "lookup_rtxcur", 13,
 414             NEW_UV(mntinfop->mik_timers[0].rtxcur), 0);
 415         hv_store(self, "read_srtt", 9,
 416             NEW_UV(mntinfop->mik_timers[1].srtt), 0);
 417         hv_store(self, "read_deviate", 12,
 418             NEW_UV(mntinfop->mik_timers[1].deviate), 0);
 419         hv_store(self, "read_rtxcur", 11,
 420             NEW_UV(mntinfop->mik_timers[1].rtxcur), 0);
 421         hv_store(self, "write_srtt", 10,
 422             NEW_UV(mntinfop->mik_timers[2].srtt), 0);
 423         hv_store(self, "write_deviate", 13,
 424             NEW_UV(mntinfop->mik_timers[2].deviate), 0);
 425         hv_store(self, "write_rtxcur", 12,
 426             NEW_UV(mntinfop->mik_timers[2].rtxcur), 0);
 427         SAVE_UINT32(self, mntinfop, mik_noresponse);
 428         SAVE_UINT32(self, mntinfop, mik_failover);
 429         SAVE_UINT32(self, mntinfop, mik_remap);
 430         SAVE_STRING(self, mntinfop, mik_curserver, strip_str);
 431 }
 432
 433 /*
 434  * The following struct => hash functions are all only present on the sparc
 435  * platform, so they are all conditionally compiled depending on __sparc
 436  */
 437
 438 /*
 439  * Definition in /usr/platform/sun4u/include/vm/hat_sfmmu.h
 440  */
 441
 442
 443 /*
 444  * Definition in /usr/platform/sun4u/include/vm/hat_sfmmu.h
 445  */
 446
 447
 448 /*
 449  * Definition in /usr/platform/sun4u/include/sys/simmstat.h
 450  */
 451
 452
 453 /*
 454  * Used by save_temperature to make CSV lists from arrays of
 455  * short temperature values
 456  */
 457
 458
 459 /*
 460  * Not actually defined anywhere - just a short.  Yuck.
 461  */
 462
 463
 464 /*
 465  * Defined in /usr/platform/sun4u/include/sys/sysctrl.h
 466  * (Well, sort of.  Actually there's no structure, just a list of #defines
 467  * enumerating *some* of the array indexes.)
 468  */
 469
 470
 471 /*
 472  * Definition in /usr/platform/sun4u/include/sys/fhc.h
 473  */
 474
 475
 476 /*
 477  * We need to be able to find the function corresponding to a particular raw
 478  * kstat.  To do this we ignore the instance and glue the module and name
 479  * together to form a composite key.  We can then use the data in the kstat
 480  * structure to find the appropriate function.  We use a perl hash to manage the
 481  * lookup, where the key is "module:name" and the value is a pointer to the
 482  * appropriate C function.
 483  *
 484  * Note that some kstats include the instance number as part of the module
 485  * and/or name.  This could be construed as a bug.  However, to work around this
 486  * we omit any digits from the module and name as we build the table in
 487  * build_raw_kstat_loopup(), and we remove any digits from the module and name
 488  * when we look up the functions in lookup_raw_kstat_fn()
 489  */
 490
 491 /*
 492  * This function is called when the XS is first dlopen()ed, and builds the
 493  * lookup table as described above.
 494  */
 495
 496 static void
 497 build_raw_kstat_lookup()
 498         {
 499         /* Create new hash */
 500         raw_kstat_lookup = newHV();
 501
 502         SAVE_FNP(raw_kstat_lookup, save_cpu_stat, "cpu_stat:cpu_stat");
 503         SAVE_FNP(raw_kstat_lookup, save_var, "unix:var");
 504         SAVE_FNP(raw_kstat_lookup, save_ncstats, "unix:ncstats");
 505         SAVE_FNP(raw_kstat_lookup, save_sysinfo, "unix:sysinfo");
 506         SAVE_FNP(raw_kstat_lookup, save_vminfo, "unix:vminfo");
 507         SAVE_FNP(raw_kstat_lookup, save_nfs, "nfs:mntinfo");
 508 }
 509
 510 /*
 511  * This finds and returns the raw kstat reader function corresponding to the
 512  * supplied module and name.  If no matching function exists, 0 is returned.
 513  */
 514
 515 static kstat_raw_reader_t lookup_raw_kstat_fn(char *module, char *name)
 516         {
 517         char                    key[KSTAT_STRLEN * 2];
 518         register char           *f, *t;
 519         SV                      **entry;
 520         kstat_raw_reader_t      fnp;
 521
 522         /* Copy across module & name, removing any digits - see comment above */
 523         for (f = module, t = key; *f != '\0'; f++, t++) {
 524                 while (*f != '\0' && isdigit(*f)) { f++; }
 525                 *t = *f;
 526         }
 527         *t++ = ':';
 528         for (f = name; *f != '\0'; f++, t++) {
 529                 while (*f != '\0' && isdigit(*f)) {
 530                         f++;
 531                 }
 532         *t = *f;
 533         }
 534         *t = '\0';
 535
 536         /* look up & return the function, or teturn 0 if not found */
 537         if ((entry = hv_fetch(raw_kstat_lookup, key, strlen(key), FALSE)) == 0)
 538         {
 539                 fnp = 0;
 540         } else {
 541                 fnp = (kstat_raw_reader_t)(uintptr_t)SvIV(*entry);
 542         }
 543         return (fnp);
 544 }
 545
 546 /*
 547  * This module converts the flat list returned by kstat_read() into a perl hash
 548  * tree keyed on module, instance, name and statistic.  The following functions
 549  * provide code to create the nested hashes, and to iterate over them.
 550  */
 551
 552 /*
 553  * Given module, instance and name keys return a pointer to the hash tied to
 554  * the bottommost hash.  If the hash already exists, we just return a pointer
 555  * to it, otherwise we create the hash and any others also required above it in
 556  * the hierarchy.  The returned tiehash is blessed into the
 557  * Sun::Solaris::Kstat::_Stat class, so that the appropriate TIEHASH methods are
 558  * called when the bottommost hash is accessed.  If the is_new parameter is
 559  * non-null it will be set to TRUE if a new tie has been created, and FALSE if
 560  * the tie already existed.
 561  */
 562
 563 static HV *
 564 get_tie(SV *self, char *module, int instance, char *name, int *is_new)
 565 {
 566         char str_inst[11];      /* big enough for up to 10^10 instances */
 567         char *key[3];           /* 3 part key: module, instance, name */
 568         int  k;
 569         int  new;
 570         HV   *hash;
 571         HV   *tie;
 572
 573         /* Create the keys */
 574         (void) snprintf(str_inst, sizeof (str_inst), "%d", instance);
 575         key[0] = module;
 576         key[1] = str_inst;
 577         key[2] = name;
 578
 579         /* Iteratively descend the tree, creating new hashes as required */
 580         hash = (HV *)SvRV(self);
 581         for (k = 0; k < 3; k++) {
 582                 SV **entry;
 583
 584                 SvREADONLY_off(hash);
 585                 entry = hv_fetch(hash, key[k], strlen(key[k]), TRUE);
 586
 587                 /* If the entry doesn't exist, create it */
 588                 if (! SvOK(*entry)) {
 589                         HV *newhash;
 590                         SV *rv;
 591
 592                         newhash = newHV();
 593                         rv = newRV_noinc((SV *)newhash);
 594                         sv_setsv(*entry, rv);
 595                         SvREFCNT_dec(rv);
 596                         if (k < 2) {
 597                                 SvREADONLY_on(newhash);
 598                         }
 599                         SvREADONLY_on(*entry);
 600                         SvREADONLY_on(hash);
 601                         hash = newhash;
 602                         new = 1;
 603
 604                 /* Otherwise it already existed */
 605                 } else {
 606                         SvREADONLY_on(hash);
 607                         hash = (HV *)SvRV(*entry);
 608                         new = 0;
 609                 }
 610         }
 611
 612         /* Create and bless a hash for the tie, if necessary */
 613         if (new) {
 614                 SV *tieref;
 615                 HV *stash;
 616
 617                 tie = newHV();
 618                 tieref = newRV_noinc((SV *)tie);
 619                 stash = gv_stashpv("Sun::Solaris::Kstat::_Stat", TRUE);
 620                 sv_bless(tieref, stash);
 621
 622                 /* Add TIEHASH magic */
 623                 hv_magic(hash, (GV *)tieref, 'P');
 624                 SvREADONLY_on(hash);
 625
 626         /* Otherwise, just find the existing tied hash */
 627         } else {
 628                 MAGIC *mg;
 629
 630                 mg = mg_find((SV *)hash, 'P');
 631                 PERL_ASSERTMSG(mg != 0, "get_tie: lost P magic");
 632                 tie = (HV *)SvRV(mg->mg_obj);
 633         }
 634         if (is_new) {
 635                 *is_new = new;
 636         }
 637         return (tie);
 638 }
 639
 640 /*
 641  * This is an iterator function used to traverse the hash hierarchy and apply
 642  * the passed function to the tied hashes at the bottom of the hierarchy.  If
 643  * any of the callback functions return 0, 0 is returned, otherwise 1
 644  */
 645
 646 static int
 647 apply_to_ties(SV *self, ATTCb_t cb, void *arg)
 648 {
 649         HV      *hash1;
 650         HE      *entry1;
 651         int     ret;
 652
 653         hash1 = (HV *)SvRV(self);
 654         hv_iterinit(hash1);
 655         ret = 1;
 656
 657         /* Iterate over each module */
 658         while ((entry1 = hv_iternext(hash1))) {
 659                 HV *hash2;
 660                 HE *entry2;
 661
 662                 hash2 = (HV *)SvRV(hv_iterval(hash1, entry1));
 663                 hv_iterinit(hash2);
 664
 665                 /* Iterate over each module:instance */
 666                 while ((entry2 = hv_iternext(hash2))) {
 667                         HV *hash3;
 668                         HE *entry3;
 669
 670                         hash3 = (HV *)SvRV(hv_iterval(hash2, entry2));
 671                         hv_iterinit(hash3);
 672
 673                         /* Iterate over each module:instance:name */
 674                         while ((entry3 = hv_iternext(hash3))) {
 675                                 HV    *hash4;
 676                                 MAGIC *mg;
 677
 678                                 /* Get the tie */
 679                                 hash4 = (HV *)SvRV(hv_iterval(hash3, entry3));
 680                                 mg = mg_find((SV *)hash4, 'P');
 681                                 PERL_ASSERTMSG(mg != 0,
 682                                     "apply_to_ties: lost P magic");
 683
 684                                 /* Apply the callback */
 685                                 if (! cb((HV *)SvRV(mg->mg_obj), arg)) {
 686                                         ret = 0;
 687                                 }
 688                         }
 689                 }
 690         }
 691         return (ret);
 692 }
 693
 694 /*
 695  * Mark this HV as valid - used by update() when pruning deleted kstat nodes
 696  */
 697
 698 static int
 699 set_valid(HV *self, void *arg)
 700 {
 701         MAGIC *mg;
 702
 703         mg = mg_find((SV *)self, '~');
 704         PERL_ASSERTMSG(mg != 0, "set_valid: lost ~ magic");
 705         ((KstatInfo_t *)SvPVX(mg->mg_obj))->valid = (int)(intptr_t)arg;
 706         return (1);
 707 }
 708
 709 /*
 710  * Prune invalid kstat nodes. This is called when kstat_chain_update() detects
 711  * that the kstat chain has been updated.  This removes any hash tree entries
 712  * that no longer have a corresponding kstat.  If del is non-null it will be
 713  * set to the keys of the deleted kstat nodes, if any.  If any entries are
 714  * deleted 1 will be retured, otherwise 0
 715  */
 716
 717 static int
 718 prune_invalid(SV *self, AV *del)
 719 {
 720         HV      *hash1;
 721         HE      *entry1;
 722         STRLEN  klen;
 723         char    *module, *instance, *name, *key;
 724         int     ret;
 725
 726         hash1 = (HV *)SvRV(self);
 727         hv_iterinit(hash1);
 728         ret = 0;
 729
 730         /* Iterate over each module */
 731         while ((entry1 = hv_iternext(hash1))) {
 732                 HV *hash2;
 733                 HE *entry2;
 734
 735                 module = HePV(entry1, PL_na);
 736                 hash2 = (HV *)SvRV(hv_iterval(hash1, entry1));
 737                 hv_iterinit(hash2);
 738
 739                 /* Iterate over each module:instance */
 740                 while ((entry2 = hv_iternext(hash2))) {
 741                         HV *hash3;
 742                         HE *entry3;
 743
 744                         instance = HePV(entry2, PL_na);
 745                         hash3 = (HV *)SvRV(hv_iterval(hash2, entry2));
 746                         hv_iterinit(hash3);
 747
 748                         /* Iterate over each module:instance:name */
 749                         while ((entry3 = hv_iternext(hash3))) {
 750                                 HV    *hash4;
 751                                 MAGIC *mg;
 752                                 HV    *tie;
 753
 754                                 name = HePV(entry3, PL_na);
 755                                 hash4 = (HV *)SvRV(hv_iterval(hash3, entry3));
 756                                 mg = mg_find((SV *)hash4, 'P');
 757                                 PERL_ASSERTMSG(mg != 0,
 758                                     "prune_invalid: lost P magic");
 759                                 tie = (HV *)SvRV(mg->mg_obj);
 760                                 mg = mg_find((SV *)tie, '~');
 761                                 PERL_ASSERTMSG(mg != 0,
 762                                     "prune_invalid: lost ~ magic");
 763
 764                                 /* If this is marked as invalid, prune it */
 765                                 if (((KstatInfo_t *)SvPVX(
 766                                     (SV *)mg->mg_obj))->valid == FALSE) {
 767                                         SvREADONLY_off(hash3);
 768                                         key = HePV(entry3, klen);
 769                                         hv_delete(hash3, key, klen, G_DISCARD);
 770                                         SvREADONLY_on(hash3);
 771                                         if (del) {
 772                                                 av_push(del,
 773                                                     newSVpvf("%s:%s:%s",
 774                                                     module, instance, name));
 775                                         }
 776                                         ret = 1;
 777                                 }
 778                         }
 779
 780                         /* If the module:instance:name hash is empty prune it */
 781                         if (HvKEYS(hash3) == 0) {
 782                                 SvREADONLY_off(hash2);
 783                                 key = HePV(entry2, klen);
 784                                 hv_delete(hash2, key, klen, G_DISCARD);
 785                                 SvREADONLY_on(hash2);
 786                         }
 787                 }
 788                 /* If the module:instance hash is empty prune it */
 789                 if (HvKEYS(hash2) == 0) {
 790                         SvREADONLY_off(hash1);
 791                         key = HePV(entry1, klen);
 792                         hv_delete(hash1, key, klen, G_DISCARD);
 793                         SvREADONLY_on(hash1);
 794                 }
 795         }
 796         return (ret);
 797 }
 798
 799 /*
 800  * Named kstats are returned as a list of key/values.  This function converts
 801  * such a list into the equivalent perl datatypes, and stores them in the passed
 802  * hash.
 803  */
 804
 805 static void
 806 save_named(HV *self, kstat_t *kp, int strip_str)
 807 {
 808         kstat_named_t   *knp;
 809         int             n;
 810         SV*             value;
 811
 812         for (n = kp->ks_ndata, knp = KSTAT_NAMED_PTR(kp); n > 0; n--, knp++) {
 813                 switch (knp->data_type) {
 814                 case KSTAT_DATA_CHAR:
 815                         value = newSVpv(knp->value.c, strip_str ?
 816                             strlen(knp->value.c) : sizeof (knp->value.c));
 817                         break;
 818                 case KSTAT_DATA_INT32:
 819                         value = newSViv(knp->value.i32);
 820                         break;
 821                 case KSTAT_DATA_UINT32:
 822                         value = NEW_UV(knp->value.ui32);
 823                         break;
 824                 case KSTAT_DATA_INT64:
 825                         value = NEW_UV(knp->value.i64);
 826                         break;
 827                 case KSTAT_DATA_UINT64:
 828                         value = NEW_UV(knp->value.ui64);
 829                         break;
 830                 case KSTAT_DATA_STRING:
 831                         if (KSTAT_NAMED_STR_PTR(knp) == NULL)
 832                                 value = newSVpv("null", sizeof ("null") - 1);
 833                         else
 834                                 value = newSVpv(KSTAT_NAMED_STR_PTR(knp),
 835                                                 KSTAT_NAMED_STR_BUFLEN(knp) -1);
 836                         break;
 837                 default:
 838                         PERL_ASSERTMSG(0, "kstat_read: invalid data type");
 839                         continue;
 840                 }
 841                 hv_store(self, knp->name, strlen(knp->name), value, 0);
 842         }
 843 }
 844
 845 /*
 846  * Save kstat interrupt statistics
 847  */
 848
 849 static void
 850 save_intr(HV *self, kstat_t *kp, int strip_str)
 851 {
 852         kstat_intr_t    *kintrp;
 853         int             i;
 854         static char     *intr_names[] =
 855             { "hard", "soft", "watchdog", "spurious", "multiple_service" };
 856
 857         PERL_ASSERT(kp->ks_ndata == 1);
 858         PERL_ASSERT(kp->ks_data_size == sizeof (kstat_intr_t));
 859         kintrp = KSTAT_INTR_PTR(kp);
 860
 861         for (i = 0; i < KSTAT_NUM_INTRS; i++) {
 862                 hv_store(self, intr_names[i], strlen(intr_names[i]),
 863                     NEW_UV(kintrp->intrs[i]), 0);
 864         }
 865 }
 866
 867 /*
 868  * Save IO statistics
 869  */
 870
 871 static void
 872 save_io(HV *self, kstat_t *kp, int strip_str)
 873 {
 874         kstat_io_t *kiop;
 875
 876         PERL_ASSERT(kp->ks_ndata == 1);
 877         PERL_ASSERT(kp->ks_data_size == sizeof (kstat_io_t));
 878         kiop = KSTAT_IO_PTR(kp);
 879         SAVE_UINT64(self, kiop, nread);
 880         SAVE_UINT64(self, kiop, nwritten);
 881         SAVE_UINT32(self, kiop, reads);
 882         SAVE_UINT32(self, kiop, writes);
 883         SAVE_HRTIME(self, kiop, wtime);
 884         SAVE_HRTIME(self, kiop, wlentime);
 885         SAVE_HRTIME(self, kiop, wlastupdate);
 886         SAVE_HRTIME(self, kiop, rtime);
 887         SAVE_HRTIME(self, kiop, rlentime);
 888         SAVE_HRTIME(self, kiop, rlastupdate);
 889         SAVE_UINT32(self, kiop, wcnt);
 890         SAVE_UINT32(self, kiop, rcnt);
 891 }
 892
 893 /*
 894  * Save timer statistics
 895  */
 896
 897 static void
 898 save_timer(HV *self, kstat_t *kp, int strip_str)
 899 {
 900         kstat_timer_t *ktimerp;
 901
 902         PERL_ASSERT(kp->ks_ndata == 1);
 903         PERL_ASSERT(kp->ks_data_size == sizeof (kstat_timer_t));
 904         ktimerp = KSTAT_TIMER_PTR(kp);
 905         SAVE_STRING(self, ktimerp, name, strip_str);
 906         SAVE_UINT64(self, ktimerp, num_events);
 907         SAVE_HRTIME(self, ktimerp, elapsed_time);
 908         SAVE_HRTIME(self, ktimerp, min_time);
 909         SAVE_HRTIME(self, ktimerp, max_time);
 910         SAVE_HRTIME(self, ktimerp, start_time);
 911         SAVE_HRTIME(self, ktimerp, stop_time);
 912 }
 913
 914 /*
 915  * Read kstats and copy into the supplied perl hash structure.  If refresh is
 916  * true, this function is being called as part of the update() method.  In this
 917  * case it is only necessary to read the kstats if they have previously been
 918  * accessed (kip->read == TRUE).  If refresh is false, this function is being
 919  * called prior to returning a value to the caller. In this case, it is only
 920  * necessary to read the kstats if they have not previously been read.  If the
 921  * kstat_read() fails, 0 is returned, otherwise 1
 922  */
 923
 924 static int
 925 read_kstats(HV *self, int refresh)
 926 {
 927         MAGIC                   *mg;
 928         KstatInfo_t             *kip;
 929         kstat_raw_reader_t      fnp;
 930
 931         /* Find the MAGIC KstatInfo_t data structure */
 932         mg = mg_find((SV *)self, '~');
 933         PERL_ASSERTMSG(mg != 0, "read_kstats: lost ~ magic");
 934         kip = (KstatInfo_t *)SvPVX(mg->mg_obj);
 935
 936         /* Return early if we don't need to actually read the kstats */
 937         if ((refresh && ! kip->read) || (! refresh && kip->read)) {
 938                 return (1);
 939         }
 940
 941         /* Read the kstats and return 0 if this fails */
 942         if (kstat_read(kip->kstat_ctl, kip->kstat, NULL) < 0) {
 943                 return (0);
 944         }
 945
 946         /* Save the read data */
 947         hv_store(self, "snaptime", 8, NEW_HRTIME(kip->kstat->ks_snaptime), 0);
 948         switch (kip->kstat->ks_type) {
 949                 case KSTAT_TYPE_RAW:
 950                         if ((fnp = lookup_raw_kstat_fn(kip->kstat->ks_module,
 951                             kip->kstat->ks_name)) != 0) {
 952                                 fnp(self, kip->kstat, kip->strip_str);
 953                         }
 954                         break;
 955                 case KSTAT_TYPE_NAMED:
 956                         save_named(self, kip->kstat, kip->strip_str);
 957                         break;
 958                 case KSTAT_TYPE_INTR:
 959                         save_intr(self, kip->kstat, kip->strip_str);
 960                         break;
 961                 case KSTAT_TYPE_IO:
 962                         save_io(self, kip->kstat, kip->strip_str);
 963                         break;
 964                 case KSTAT_TYPE_TIMER:
 965                         save_timer(self, kip->kstat, kip->strip_str);
 966                         break;
 967                 default:
 968                         PERL_ASSERTMSG(0, "read_kstats: illegal kstat type");
 969                         break;
 970         }
 971         kip->read = TRUE;
 972         return (1);
 973 }
 974
 975 /*
 976  * The XS code exported to perl is below here.  Note that the XS preprocessor
 977  * has its own commenting syntax, so all comments from this point on are in
 978  * that form.
 979  */
 980
 981 /* The following XS methods are the ABI of the Sun::Solaris::Kstat package */
 982
 983 MODULE = Sun::Solaris::Kstat PACKAGE = Sun::Solaris::Kstat
 984 PROTOTYPES: ENABLE
 985
 986  # Create the raw kstat to store function lookup table on load
 987 BOOT:
 988         build_raw_kstat_lookup();
 989
 990  #
 991  # The Sun::Solaris::Kstat constructor.  This builds the nested
 992  # name::instance::module hash structure, but doesn't actually read the
 993  # underlying kstats.  This is done on demand by the TIEHASH methods in
 994  # Sun::Solaris::Kstat::_Stat
 995  #
 996
 997 SV*
 998 new(class, ...)
 999         char *class;
1000 PREINIT:
1001         HV              *stash;
1002         kstat_ctl_t     *kc;
1003         SV              *kcsv;
1004         kstat_t         *kp;
1005         KstatInfo_t     kstatinfo;
1006         int             sp, strip_str;
1007 CODE:
1008         /* Check we have an even number of arguments, excluding the class */
1009         sp = 1;
1010         if (((items - sp) % 2) != 0) {
1011                 croak(DEBUG_ID ": new: invalid number of arguments");
1012         }
1013
1014         /* Process any (name => value) arguments */
1015         strip_str = 0;
1016         while (sp < items) {
1017                 SV *name, *value;
1018
1019                 name = ST(sp);
1020                 sp++;
1021                 value = ST(sp);
1022                 sp++;
1023                 if (strcmp(SvPVX(name), "strip_strings") == 0) {
1024                         strip_str = SvTRUE(value);
1025                 } else {
1026                         croak(DEBUG_ID ": new: invalid parameter name '%s'",
1027                             SvPVX(name));
1028                 }
1029         }
1030
1031         /* Open the kstats handle */
1032         if ((kc = kstat_open()) == 0) {
1033                 XSRETURN_UNDEF;
1034         }
1035
1036         /* Create a blessed hash ref */
1037         RETVAL = (SV *)newRV_noinc((SV *)newHV());
1038         stash = gv_stashpv(class, TRUE);
1039         sv_bless(RETVAL, stash);
1040
1041         /* Create a place to save the KstatInfo_t structure */
1042         kcsv = newSVpv((char *)&kc, sizeof (kc));
1043         sv_magic(SvRV(RETVAL), kcsv, '~', 0, 0);
1044         SvREFCNT_dec(kcsv);
1045
1046         /* Initialise the KstatsInfo_t structure */
1047         kstatinfo.read = FALSE;
1048         kstatinfo.valid = TRUE;
1049         kstatinfo.strip_str = strip_str;
1050         kstatinfo.kstat_ctl = kc;
1051
1052         /* Scan the kstat chain, building hash entries for the kstats */
1053         for (kp = kc->kc_chain; kp != 0; kp = kp->ks_next) {
1054                 HV *tie;
1055                 SV *kstatsv;
1056
1057                 /* Don't bother storing the kstat headers */
1058                 if (strncmp(kp->ks_name, "kstat_", 6) == 0) {
1059                         continue;
1060                 }
1061
1062                 /* Don't bother storing raw stats we don't understand */
1063                 if (kp->ks_type == KSTAT_TYPE_RAW &&
1064                     lookup_raw_kstat_fn(kp->ks_module, kp->ks_name) == 0) {
1065 #ifdef REPORT_UNKNOWN
1066                         (void) fprintf(stderr,
1067                             "Unknown kstat type %s:%d:%s - %d of size %d\n",
1068                             kp->ks_module, kp->ks_instance, kp->ks_name,
1069                             kp->ks_ndata, kp->ks_data_size);
1070 #endif
1071                         continue;
1072                 }
1073
1074                 /* Create a 3-layer hash hierarchy - module.instance.name */
1075                 tie = get_tie(RETVAL, kp->ks_module, kp->ks_instance,
1076                     kp->ks_name, 0);
1077
1078                 /* Save the data necessary to read the kstat info on demand */
1079                 hv_store(tie, "class", 5, newSVpv(kp->ks_class, 0), 0);
1080                 hv_store(tie, "crtime", 6, NEW_HRTIME(kp->ks_crtime), 0);
1081                 kstatinfo.kstat = kp;
1082                 kstatsv = newSVpv((char *)&kstatinfo, sizeof (kstatinfo));
1083                 sv_magic((SV *)tie, kstatsv, '~', 0, 0);
1084                 SvREFCNT_dec(kstatsv);
1085         }
1086         SvREADONLY_on(SvRV(RETVAL));
1087         /* SvREADONLY_on(RETVAL); */
1088 OUTPUT:
1089         RETVAL
1090
1091  #
1092  # Update the perl hash structure so that it is in line with the kernel kstats
1093  # data.  Only kstats athat have previously been accessed are read,
1094  #
1095
1096  # Scalar context: true/false
1097  # Array context: (\@added, \@deleted)
1098 void
1099 update(self)
1100         SV* self;
1101 PREINIT:
1102         MAGIC           *mg;
1103         kstat_ctl_t     *kc;
1104         kstat_t         *kp;
1105         int             ret;
1106         AV              *add, *del;
1107 PPCODE:
1108         /* Find the hidden KstatInfo_t structure */
1109         mg = mg_find(SvRV(self), '~');
1110         PERL_ASSERTMSG(mg != 0, "update: lost ~ magic");
1111         kc = *(kstat_ctl_t **)SvPVX(mg->mg_obj);
1112
1113         /* Update the kstat chain, and return immediately on error. */
1114         if ((ret = kstat_chain_update(kc)) == -1) {
1115                 if (GIMME_V == G_ARRAY) {
1116                         EXTEND(SP, 2);
1117                         PUSHs(sv_newmortal());
1118                         PUSHs(sv_newmortal());
1119                 } else {
1120                         EXTEND(SP, 1);
1121                         PUSHs(sv_2mortal(newSViv(ret)));
1122                 }
1123         }
1124
1125         /* Create the arrays to be returned if in an array context */
1126         if (GIMME_V == G_ARRAY) {
1127                 add = newAV();
1128                 del = newAV();
1129         } else {
1130                 add = 0;
1131                 del = 0;
1132         }
1133
1134         /*
1135          * If the kstat chain hasn't changed we can just reread any stats
1136          * that have already been read
1137          */
1138         if (ret == 0) {
1139                 if (! apply_to_ties(self, (ATTCb_t)read_kstats, (void *)TRUE)) {
1140                         if (GIMME_V == G_ARRAY) {
1141                                 EXTEND(SP, 2);
1142                                 PUSHs(sv_2mortal(newRV_noinc((SV *)add)));
1143                                 PUSHs(sv_2mortal(newRV_noinc((SV *)del)));
1144                         } else {
1145                                 EXTEND(SP, 1);
1146                                 PUSHs(sv_2mortal(newSViv(-1)));
1147                         }
1148                 }
1149
1150         /*
1151          * Otherwise we have to update the Perl structure so that it is in
1152          * agreement with the new kstat chain.  We do this in such a way as to
1153          * retain all the existing structures, just adding or deleting the
1154          * bare minimum.
1155          */
1156         } else {
1157                 KstatInfo_t     kstatinfo;
1158
1159                 /*
1160                  * Step 1: set the 'invalid' flag on each entry
1161                  */
1162                 apply_to_ties(self, &set_valid, (void *)FALSE);
1163
1164                 /*
1165                  * Step 2: Set the 'valid' flag on all entries still in the
1166                  * kernel kstat chain
1167                  */
1168                 kstatinfo.read          = FALSE;
1169                 kstatinfo.valid         = TRUE;
1170                 kstatinfo.kstat_ctl     = kc;
1171                 for (kp = kc->kc_chain; kp != 0; kp = kp->ks_next) {
1172                         int     new;
1173                         HV      *tie;
1174
1175                         /* Don't bother storing the kstat headers or types */
1176                         if (strncmp(kp->ks_name, "kstat_", 6) == 0) {
1177                                 continue;
1178                         }
1179
1180                         /* Don't bother storing raw stats we don't understand */
1181                         if (kp->ks_type == KSTAT_TYPE_RAW &&
1182                             lookup_raw_kstat_fn(kp->ks_module, kp->ks_name)
1183                             == 0) {
1184 #ifdef REPORT_UNKNOWN
1185                                 (void) printf("Unknown kstat type %s:%d:%s "
1186                                     "- %d of size %d\n", kp->ks_module,
1187                                     kp->ks_instance, kp->ks_name,
1188                                     kp->ks_ndata, kp->ks_data_size);
1189 #endif
1190                                 continue;
1191                         }
1192
1193                         /* Find the tied hash associated with the kstat entry */
1194                         tie = get_tie(self, kp->ks_module, kp->ks_instance,
1195                             kp->ks_name, &new);
1196
1197                         /* If newly created store the associated kstat info */
1198                         if (new) {
1199                                 SV *kstatsv;
1200
1201                                 /*
1202                                  * Save the data necessary to read the kstat
1203                                  * info on demand
1204                                  */
1205                                 hv_store(tie, "class", 5,
1206                                     newSVpv(kp->ks_class, 0), 0);
1207                                 hv_store(tie, "crtime", 6,
1208                                     NEW_HRTIME(kp->ks_crtime), 0);
1209                                 kstatinfo.kstat = kp;
1210                                 kstatsv = newSVpv((char *)&kstatinfo,
1211                                     sizeof (kstatinfo));
1212                                 sv_magic((SV *)tie, kstatsv, '~', 0, 0);
1213                                 SvREFCNT_dec(kstatsv);
1214
1215                                 /* Save the key on the add list, if required */
1216                                 if (GIMME_V == G_ARRAY) {
1217                                         av_push(add, newSVpvf("%s:%d:%s",
1218                                             kp->ks_module, kp->ks_instance,
1219                                             kp->ks_name));
1220                                 }
1221
1222                         /* If the stats already exist, just update them */
1223                         } else {
1224                                 MAGIC *mg;
1225                                 KstatInfo_t *kip;
1226
1227                                 /* Find the hidden KstatInfo_t */
1228                                 mg = mg_find((SV *)tie, '~');
1229                                 PERL_ASSERTMSG(mg != 0, "update: lost ~ magic");
1230                                 kip = (KstatInfo_t *)SvPVX(mg->mg_obj);
1231
1232                                 /* Mark the tie as valid */
1233                                 kip->valid = TRUE;
1234
1235                                 /* Re-save the kstat_t pointer.  If the kstat
1236                                  * has been deleted and re-added since the last
1237                                  * update, the address of the kstat structure
1238                                  * will have changed, even though the kstat will
1239                                  * still live at the same place in the perl
1240                                  * hash tree structure.
1241                                  */
1242                                 kip->kstat = kp;
1243
1244                                 /* Reread the stats, if read previously */
1245                                 read_kstats(tie, TRUE);
1246                         }
1247                 }
1248
1249                 /*
1250                  *Step 3: Delete any entries still marked as 'invalid'
1251                  */
1252                 ret = prune_invalid(self, del);
1253
1254         }
1255         if (GIMME_V == G_ARRAY) {
1256                 EXTEND(SP, 2);
1257                 PUSHs(sv_2mortal(newRV_noinc((SV *)add)));
1258                 PUSHs(sv_2mortal(newRV_noinc((SV *)del)));
1259         } else {
1260                 EXTEND(SP, 1);
1261                 PUSHs(sv_2mortal(newSViv(ret)));
1262         }
1263
1264
1265  #
1266  # Destructor.  Closes the kstat connection
1267  #
1268
1269 void
1270 DESTROY(self)
1271         SV *self;
1272 PREINIT:
1273         MAGIC           *mg;
1274         kstat_ctl_t     *kc;
1275 CODE:
1276         mg = mg_find(SvRV(self), '~');
1277         PERL_ASSERTMSG(mg != 0, "DESTROY: lost ~ magic");
1278         kc = *(kstat_ctl_t **)SvPVX(mg->mg_obj);
1279         if (kstat_close(kc) != 0) {
1280                 croak(DEBUG_ID ": kstat_close: failed");
1281         }
1282
1283  #
1284  # The following XS methods implement the TIEHASH mechanism used to update the
1285  # kstats hash structure.  These are blessed into a package that isn't
1286  # visible to callers of the Sun::Solaris::Kstat module
1287  #
1288
1289 MODULE = Sun::Solaris::Kstat PACKAGE = Sun::Solaris::Kstat::_Stat
1290 PROTOTYPES: ENABLE
1291
1292  #
1293  # If a value has already been read, return it.  Otherwise read the appropriate
1294  # kstat and then return the value
1295  #
1296
1297 SV*
1298 FETCH(self, key)
1299         SV* self;
1300         SV* key;
1301 PREINIT:
1302         char    *k;
1303         STRLEN  klen;
1304         SV      **value;
1305 CODE:
1306         self = SvRV(self);
1307         k = SvPV(key, klen);
1308         if (strNE(k, "class") && strNE(k, "crtime")) {
1309                 read_kstats((HV *)self, FALSE);
1310         }
1311         value = hv_fetch((HV *)self, k, klen, FALSE);
1312         if (value) {
1313                 RETVAL = *value; SvREFCNT_inc(RETVAL);
1314         } else {
1315                 RETVAL = &PL_sv_undef;
1316         }
1317 OUTPUT:
1318         RETVAL
1319
1320  #
1321  # Save the passed value into the kstat hash.  Read the appropriate kstat first,
1322  # if necessary.  Note that this DOES NOT update the underlying kernel kstat
1323  # structure.
1324  #
1325
1326 SV*
1327 STORE(self, key, value)
1328         SV* self;
1329         SV* key;
1330         SV* value;
1331 PREINIT:
1332         char    *k;
1333         STRLEN  klen;
1334 CODE:
1335         self = SvRV(self);
1336         k = SvPV(key, klen);
1337         if (strNE(k, "class") && strNE(k, "crtime")) {
1338                 read_kstats((HV *)self, FALSE);
1339         }
1340         SvREFCNT_inc(value);
1341         RETVAL = *(hv_store((HV *)self, k, klen, value, 0));
1342         SvREFCNT_inc(RETVAL);
1343 OUTPUT:
1344         RETVAL
1345
1346  #
1347  # Check for the existence of the passed key.  Read the kstat first if necessary
1348  #
1349
1350 bool
1351 EXISTS(self, key)
1352         SV* self;
1353         SV* key;
1354 PREINIT:
1355         char *k;
1356 CODE:
1357         self = SvRV(self);
1358         k = SvPV(key, PL_na);
1359         if (strNE(k, "class") && strNE(k, "crtime")) {
1360                 read_kstats((HV *)self, FALSE);
1361         }
1362         RETVAL = hv_exists_ent((HV *)self, key, 0);
1363 OUTPUT:
1364         RETVAL
1365
1366
1367  #
1368  # Hash iterator initialisation.  Read the kstats if necessary.
1369  #
1370
1371 SV*
1372 FIRSTKEY(self)
1373         SV* self;
1374 PREINIT:
1375         HE *he;
1376 PPCODE:
1377         self = SvRV(self);
1378         read_kstats((HV *)self, FALSE);
1379         hv_iterinit((HV *)self);
1380         if ((he = hv_iternext((HV *)self))) {
1381                 EXTEND(SP, 1);
1382                 PUSHs(hv_iterkeysv(he));
1383         }
1384
1385  #
1386  # Return hash iterator next value.  Read the kstats if necessary.
1387  #
1388
1389 SV*
1390 NEXTKEY(self, lastkey)
1391         SV* self;
1392         SV* lastkey;
1393 PREINIT:
1394         HE *he;
1395 PPCODE:
1396         self = SvRV(self);
1397         if ((he = hv_iternext((HV *)self))) {
1398                 EXTEND(SP, 1);
1399                 PUSHs(hv_iterkeysv(he));
1400         }
1401
1402
1403  #
1404  # Delete the specified hash entry.
1405  #
1406
1407 SV*
1408 DELETE(self, key)
1409         SV *self;
1410         SV *key;
1411 CODE:
1412         self = SvRV(self);
1413         RETVAL = hv_delete_ent((HV *)self, key, 0, 0);
1414         if (RETVAL) {
1415                 SvREFCNT_inc(RETVAL);
1416         } else {
1417                 RETVAL = &PL_sv_undef;
1418         }
1419 OUTPUT:
1420         RETVAL
1421
1422  #
1423  # Clear the entire hash.  This will stop any update() calls rereading this
1424  # kstat until it is accessed again.
1425  #
1426
1427 void
1428 CLEAR(self)
1429         SV* self;
1430 PREINIT:
1431         MAGIC   *mg;
1432         KstatInfo_t *kip;
1433 CODE:
1434         self = SvRV(self);
1435         hv_clear((HV *)self);
1436         mg = mg_find(self, '~');
1437         PERL_ASSERTMSG(mg != 0, "CLEAR: lost ~ magic");
1438         kip = (KstatInfo_t *)SvPVX(mg->mg_obj);
1439         kip->read  = FALSE;
1440         kip->valid = TRUE;
1441         hv_store((HV *)self, "class", 5, newSVpv(kip->kstat->ks_class, 0), 0);
1442         hv_store((HV *)self, "crtime", 6, NEW_HRTIME(kip->kstat->ks_crtime), 0);