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