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