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
save_cpu_stat(HV * self,kstat_t * kp,int strip_str)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
save_var(HV * self,kstat_t * kp,int strip_str)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
save_ncstats(HV * self,kstat_t * kp,int strip_str)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
save_sysinfo(HV * self,kstat_t * kp,int strip_str)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
save_vminfo(HV * self,kstat_t * kp,int strip_str)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
save_nfs(HV * self,kstat_t * kp,int strip_str)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
save_sfmmu_global_stat(HV * self,kstat_t * kp,int strip_str)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
save_sfmmu_tsbsize_stat(HV * self,kstat_t * kp,int strip_str)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
build_raw_kstat_lookup()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
lookup_raw_kstat_fn(char * module,char * name)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 *
get_tie(SV * self,char * module,int instance,char * name,int * is_new)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
apply_to_ties(SV * self,ATTCb_t cb,void * arg)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
set_valid(HV * self,void * arg)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
prune_invalid(SV * self,AV * del)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
save_named(HV * self,kstat_t * kp,int strip_str)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
save_intr(HV * self,kstat_t * kp,int strip_str)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
save_io(HV * self,kstat_t * kp,int strip_str)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
save_timer(HV * self,kstat_t * kp,int strip_str)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
read_kstats(HV * self,int refresh)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
read_kstats_wrap(HV * self,void * ptr)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