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 */
152typedef 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 */
161typedef int (*ATTCb_t)(HV *, void *);
162
163/* typedef for raw kstat reader functions */
164typedef void (*kstat_raw_reader_t)(HV *, kstat_t *, int);
165
166/* Hash of "module:name" to KSTAT_RAW read functions */
167static 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
180static void
181save_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
298static void
299save_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
328static void
329save_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
351static void
352save_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
372static void
373save_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
393static void
394save_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
448static void
449save_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
526static void
527save_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
568static void
569build_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
593static 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
641static HV *
642get_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		SvREADONLY_on(hash);
703
704	/* Otherwise, just find the existing tied hash */
705	} else {
706		MAGIC *mg;
707
708		mg = mg_find((SV *)hash, 'P');
709		PERL_ASSERTMSG(mg != 0, "get_tie: lost P magic");
710		tie = (HV *)SvRV(mg->mg_obj);
711	}
712	if (is_new) {
713		*is_new = new;
714	}
715	return (tie);
716}
717
718/*
719 * This is an iterator function used to traverse the hash hierarchy and apply
720 * the passed function to the tied hashes at the bottom of the hierarchy.  If
721 * any of the callback functions return 0, 0 is returned, otherwise 1
722 */
723
724static int
725apply_to_ties(SV *self, ATTCb_t cb, void *arg)
726{
727	HV	*hash1;
728	HE	*entry1;
729	int	ret;
730
731	hash1 = (HV *)SvRV(self);
732	hv_iterinit(hash1);
733	ret = 1;
734
735	/* Iterate over each module */
736	while ((entry1 = hv_iternext(hash1))) {
737		HV *hash2;
738		HE *entry2;
739
740		hash2 = (HV *)SvRV(hv_iterval(hash1, entry1));
741		hv_iterinit(hash2);
742
743		/* Iterate over each module:instance */
744		while ((entry2 = hv_iternext(hash2))) {
745			HV *hash3;
746			HE *entry3;
747
748			hash3 = (HV *)SvRV(hv_iterval(hash2, entry2));
749			hv_iterinit(hash3);
750
751			/* Iterate over each module:instance:name */
752			while ((entry3 = hv_iternext(hash3))) {
753				HV    *hash4;
754				MAGIC *mg;
755
756				/* Get the tie */
757				hash4 = (HV *)SvRV(hv_iterval(hash3, entry3));
758				mg = mg_find((SV *)hash4, 'P');
759				PERL_ASSERTMSG(mg != 0,
760				    "apply_to_ties: lost P magic");
761
762				/* Apply the callback */
763				if (! cb((HV *)SvRV(mg->mg_obj), arg)) {
764					ret = 0;
765				}
766			}
767		}
768	}
769	return (ret);
770}
771
772/*
773 * Mark this HV as valid - used by update() when pruning deleted kstat nodes
774 */
775
776static int
777set_valid(HV *self, void *arg)
778{
779	MAGIC *mg;
780
781	mg = mg_find((SV *)self, '~');
782	PERL_ASSERTMSG(mg != 0, "set_valid: lost ~ magic");
783	((KstatInfo_t *)SvPVX(mg->mg_obj))->valid = (int)(intptr_t)arg;
784	return (1);
785}
786
787/*
788 * Prune invalid kstat nodes. This is called when kstat_chain_update() detects
789 * that the kstat chain has been updated.  This removes any hash tree entries
790 * that no longer have a corresponding kstat.  If del is non-null it will be
791 * set to the keys of the deleted kstat nodes, if any.  If any entries are
792 * deleted 1 will be retured, otherwise 0
793 */
794
795static int
796prune_invalid(SV *self, AV *del)
797{
798	HV	*hash1;
799	HE	*entry1;
800	STRLEN	klen;
801	char	*module, *instance, *name, *key;
802	int	ret;
803
804	hash1 = (HV *)SvRV(self);
805	hv_iterinit(hash1);
806	ret = 0;
807
808	/* Iterate over each module */
809	while ((entry1 = hv_iternext(hash1))) {
810		HV *hash2;
811		HE *entry2;
812
813		module = HePV(entry1, PL_na);
814		hash2 = (HV *)SvRV(hv_iterval(hash1, entry1));
815		hv_iterinit(hash2);
816
817		/* Iterate over each module:instance */
818		while ((entry2 = hv_iternext(hash2))) {
819			HV *hash3;
820			HE *entry3;
821
822			instance = HePV(entry2, PL_na);
823			hash3 = (HV *)SvRV(hv_iterval(hash2, entry2));
824			hv_iterinit(hash3);
825
826			/* Iterate over each module:instance:name */
827			while ((entry3 = hv_iternext(hash3))) {
828				HV    *hash4;
829				MAGIC *mg;
830				HV    *tie;
831
832				name = HePV(entry3, PL_na);
833				hash4 = (HV *)SvRV(hv_iterval(hash3, entry3));
834				mg = mg_find((SV *)hash4, 'P');
835				PERL_ASSERTMSG(mg != 0,
836				    "prune_invalid: lost P magic");
837				tie = (HV *)SvRV(mg->mg_obj);
838				mg = mg_find((SV *)tie, '~');
839				PERL_ASSERTMSG(mg != 0,
840				    "prune_invalid: lost ~ magic");
841
842				/* If this is marked as invalid, prune it */
843				if (((KstatInfo_t *)SvPVX(
844				    (SV *)mg->mg_obj))->valid == FALSE) {
845					SvREADONLY_off(hash3);
846					key = HePV(entry3, klen);
847					hv_delete(hash3, key, klen, G_DISCARD);
848					SvREADONLY_on(hash3);
849					if (del) {
850						av_push(del,
851						    newSVpvf("%s:%s:%s",
852						    module, instance, name));
853					}
854					ret = 1;
855				}
856			}
857
858			/* If the module:instance:name hash is empty prune it */
859			if (HvKEYS(hash3) == 0) {
860				SvREADONLY_off(hash2);
861				key = HePV(entry2, klen);
862				hv_delete(hash2, key, klen, G_DISCARD);
863				SvREADONLY_on(hash2);
864			}
865		}
866		/* If the module:instance hash is empty prune it */
867		if (HvKEYS(hash2) == 0) {
868			SvREADONLY_off(hash1);
869			key = HePV(entry1, klen);
870			hv_delete(hash1, key, klen, G_DISCARD);
871			SvREADONLY_on(hash1);
872		}
873	}
874	return (ret);
875}
876
877/*
878 * Named kstats are returned as a list of key/values.  This function converts
879 * such a list into the equivalent perl datatypes, and stores them in the passed
880 * hash.
881 */
882
883static void
884save_named(HV *self, kstat_t *kp, int strip_str)
885{
886	kstat_named_t	*knp;
887	int		n;
888	SV*		value;
889
890	for (n = kp->ks_ndata, knp = KSTAT_NAMED_PTR(kp); n > 0; n--, knp++) {
891		switch (knp->data_type) {
892		case KSTAT_DATA_CHAR:
893			value = newSVpv(knp->value.c, strip_str ?
894			    strlen(knp->value.c) : sizeof (knp->value.c));
895			break;
896		case KSTAT_DATA_INT32:
897			value = newSViv(knp->value.i32);
898			break;
899		case KSTAT_DATA_UINT32:
900			value = NEW_UV(knp->value.ui32);
901			break;
902		case KSTAT_DATA_INT64:
903			value = NEW_UV(knp->value.i64);
904			break;
905		case KSTAT_DATA_UINT64:
906			value = NEW_UV(knp->value.ui64);
907			break;
908		case KSTAT_DATA_STRING:
909			if (KSTAT_NAMED_STR_PTR(knp) == NULL)
910				value = newSVpv("null", sizeof ("null") - 1);
911			else
912				value = newSVpv(KSTAT_NAMED_STR_PTR(knp),
913						KSTAT_NAMED_STR_BUFLEN(knp) -1);
914			break;
915		default:
916			PERL_ASSERTMSG(0, "kstat_read: invalid data type");
917			continue;
918		}
919		hv_store(self, knp->name, strlen(knp->name), value, 0);
920	}
921}
922
923/*
924 * Save kstat interrupt statistics
925 */
926
927static void
928save_intr(HV *self, kstat_t *kp, int strip_str)
929{
930	kstat_intr_t	*kintrp;
931	int		i;
932	static char	*intr_names[] =
933	    { "hard", "soft", "watchdog", "spurious", "multiple_service" };
934
935	PERL_ASSERT(kp->ks_ndata == 1);
936	PERL_ASSERT(kp->ks_data_size == sizeof (kstat_intr_t));
937	kintrp = KSTAT_INTR_PTR(kp);
938
939	for (i = 0; i < KSTAT_NUM_INTRS; i++) {
940		hv_store(self, intr_names[i], strlen(intr_names[i]),
941		    NEW_UV(kintrp->intrs[i]), 0);
942	}
943}
944
945/*
946 * Save IO statistics
947 */
948
949static void
950save_io(HV *self, kstat_t *kp, int strip_str)
951{
952	kstat_io_t *kiop;
953
954	PERL_ASSERT(kp->ks_ndata == 1);
955	PERL_ASSERT(kp->ks_data_size == sizeof (kstat_io_t));
956	kiop = KSTAT_IO_PTR(kp);
957	SAVE_UINT64(self, kiop, nread);
958	SAVE_UINT64(self, kiop, nwritten);
959	SAVE_UINT32(self, kiop, reads);
960	SAVE_UINT32(self, kiop, writes);
961	SAVE_HRTIME(self, kiop, wtime);
962	SAVE_HRTIME(self, kiop, wlentime);
963	SAVE_HRTIME(self, kiop, wlastupdate);
964	SAVE_HRTIME(self, kiop, rtime);
965	SAVE_HRTIME(self, kiop, rlentime);
966	SAVE_HRTIME(self, kiop, rlastupdate);
967	SAVE_UINT32(self, kiop, wcnt);
968	SAVE_UINT32(self, kiop, rcnt);
969}
970
971/*
972 * Save timer statistics
973 */
974
975static void
976save_timer(HV *self, kstat_t *kp, int strip_str)
977{
978	kstat_timer_t *ktimerp;
979
980	PERL_ASSERT(kp->ks_ndata == 1);
981	PERL_ASSERT(kp->ks_data_size == sizeof (kstat_timer_t));
982	ktimerp = KSTAT_TIMER_PTR(kp);
983	SAVE_STRING(self, ktimerp, name, strip_str);
984	SAVE_UINT64(self, ktimerp, num_events);
985	SAVE_HRTIME(self, ktimerp, elapsed_time);
986	SAVE_HRTIME(self, ktimerp, min_time);
987	SAVE_HRTIME(self, ktimerp, max_time);
988	SAVE_HRTIME(self, ktimerp, start_time);
989	SAVE_HRTIME(self, ktimerp, stop_time);
990}
991
992/*
993 * Read kstats and copy into the supplied perl hash structure.  If refresh is
994 * true, this function is being called as part of the update() method.  In this
995 * case it is only necessary to read the kstats if they have previously been
996 * accessed (kip->read == TRUE).  If refresh is false, this function is being
997 * called prior to returning a value to the caller. In this case, it is only
998 * necessary to read the kstats if they have not previously been read.  If the
999 * kstat_read() fails, 0 is returned, otherwise 1
1000 */
1001
1002static int
1003read_kstats(HV *self, int refresh)
1004{
1005	MAGIC			*mg;
1006	KstatInfo_t		*kip;
1007	kstat_raw_reader_t	fnp;
1008
1009	/* Find the MAGIC KstatInfo_t data structure */
1010	mg = mg_find((SV *)self, '~');
1011	PERL_ASSERTMSG(mg != 0, "read_kstats: lost ~ magic");
1012	kip = (KstatInfo_t *)SvPVX(mg->mg_obj);
1013
1014	/* Return early if we don't need to actually read the kstats */
1015	if ((refresh && ! kip->read) || (! refresh && kip->read)) {
1016		return (1);
1017	}
1018
1019	/* Read the kstats and return 0 if this fails */
1020	if (kstat_read(kip->kstat_ctl, kip->kstat, NULL) < 0) {
1021		return (0);
1022	}
1023
1024	/* Save the read data */
1025	hv_store(self, "snaptime", 8, NEW_HRTIME(kip->kstat->ks_snaptime), 0);
1026	switch (kip->kstat->ks_type) {
1027		case KSTAT_TYPE_RAW:
1028			if ((fnp = lookup_raw_kstat_fn(kip->kstat->ks_module,
1029			    kip->kstat->ks_name)) != 0) {
1030				fnp(self, kip->kstat, kip->strip_str);
1031			}
1032			break;
1033		case KSTAT_TYPE_NAMED:
1034			save_named(self, kip->kstat, kip->strip_str);
1035			break;
1036		case KSTAT_TYPE_INTR:
1037			save_intr(self, kip->kstat, kip->strip_str);
1038			break;
1039		case KSTAT_TYPE_IO:
1040			save_io(self, kip->kstat, kip->strip_str);
1041			break;
1042		case KSTAT_TYPE_TIMER:
1043			save_timer(self, kip->kstat, kip->strip_str);
1044			break;
1045		default:
1046			PERL_ASSERTMSG(0, "read_kstats: illegal kstat type");
1047			break;
1048	}
1049	kip->read = TRUE;
1050	return (1);
1051}
1052
1053static int
1054read_kstats_wrap(HV *self, void *ptr)
1055{
1056	int refresh = (intptr_t)ptr;
1057
1058	return (read_kstats(self, refresh));
1059}
1060
1061/*
1062 * The XS code exported to perl is below here.  Note that the XS preprocessor
1063 * has its own commenting syntax, so all comments from this point on are in
1064 * that form.
1065 */
1066
1067/* The following XS methods are the ABI of the Sun::Solaris::Kstat package */
1068
1069MODULE = Sun::Solaris::Kstat PACKAGE = Sun::Solaris::Kstat
1070PROTOTYPES: ENABLE
1071
1072 # Create the raw kstat to store function lookup table on load
1073BOOT:
1074	build_raw_kstat_lookup();
1075
1076 #
1077 # The Sun::Solaris::Kstat constructor.  This builds the nested
1078 # name::instance::module hash structure, but doesn't actually read the
1079 # underlying kstats.  This is done on demand by the TIEHASH methods in
1080 # Sun::Solaris::Kstat::_Stat
1081 #
1082
1083SV*
1084new(class, ...)
1085	char *class;
1086PREINIT:
1087	HV		*stash;
1088	kstat_ctl_t	*kc;
1089	SV		*kcsv;
1090	kstat_t		*kp;
1091	KstatInfo_t	kstatinfo;
1092	int		sp, strip_str;
1093CODE:
1094	/* Check we have an even number of arguments, excluding the class */
1095	sp = 1;
1096	if (((items - sp) % 2) != 0) {
1097		croak(DEBUG_ID ": new: invalid number of arguments");
1098	}
1099
1100	/* Process any (name => value) arguments */
1101	strip_str = 0;
1102	while (sp < items) {
1103		SV *name, *value;
1104
1105		name = ST(sp);
1106		sp++;
1107		value = ST(sp);
1108		sp++;
1109		if (strcmp(SvPVX(name), "strip_strings") == 0) {
1110			strip_str = SvTRUE(value);
1111		} else {
1112			croak(DEBUG_ID ": new: invalid parameter name '%s'",
1113			    SvPVX(name));
1114		}
1115	}
1116
1117	/* Open the kstats handle */
1118	if ((kc = kstat_open()) == 0) {
1119		XSRETURN_UNDEF;
1120	}
1121
1122	/* Create a blessed hash ref */
1123	RETVAL = (SV *)newRV_noinc((SV *)newHV());
1124	stash = gv_stashpv(class, TRUE);
1125	sv_bless(RETVAL, stash);
1126
1127	/* Create a place to save the KstatInfo_t structure */
1128	kcsv = newSVpv((char *)&kc, sizeof (kc));
1129	sv_magic(SvRV(RETVAL), kcsv, '~', 0, 0);
1130	SvREFCNT_dec(kcsv);
1131
1132	/* Initialise the KstatsInfo_t structure */
1133	kstatinfo.read = FALSE;
1134	kstatinfo.valid = TRUE;
1135	kstatinfo.strip_str = strip_str;
1136	kstatinfo.kstat_ctl = kc;
1137
1138	/* Scan the kstat chain, building hash entries for the kstats */
1139	for (kp = kc->kc_chain; kp != 0; kp = kp->ks_next) {
1140		HV *tie;
1141		SV *kstatsv;
1142
1143		/* Don't bother storing the kstat headers */
1144		if (strncmp(kp->ks_name, "kstat_", 6) == 0) {
1145			continue;
1146		}
1147
1148		/* Don't bother storing raw stats we don't understand */
1149		if (kp->ks_type == KSTAT_TYPE_RAW &&
1150		    lookup_raw_kstat_fn(kp->ks_module, kp->ks_name) == 0) {
1151#ifdef REPORT_UNKNOWN
1152			(void) fprintf(stderr,
1153			    "Unknown kstat type %s:%d:%s - %d of size %d\n",
1154			    kp->ks_module, kp->ks_instance, kp->ks_name,
1155			    kp->ks_ndata, kp->ks_data_size);
1156#endif
1157			continue;
1158		}
1159
1160		/* Create a 3-layer hash hierarchy - module.instance.name */
1161		tie = get_tie(RETVAL, kp->ks_module, kp->ks_instance,
1162		    kp->ks_name, 0);
1163
1164		/* Save the data necessary to read the kstat info on demand */
1165		hv_store(tie, "class", 5, newSVpv(kp->ks_class, 0), 0);
1166		hv_store(tie, "crtime", 6, NEW_HRTIME(kp->ks_crtime), 0);
1167		kstatinfo.kstat = kp;
1168		kstatsv = newSVpv((char *)&kstatinfo, sizeof (kstatinfo));
1169		sv_magic((SV *)tie, kstatsv, '~', 0, 0);
1170		SvREFCNT_dec(kstatsv);
1171	}
1172	SvREADONLY_on(SvRV(RETVAL));
1173	/* SvREADONLY_on(RETVAL); */
1174OUTPUT:
1175	RETVAL
1176
1177 #
1178 # Update the perl hash structure so that it is in line with the kernel kstats
1179 # data.  Only kstats athat have previously been accessed are read,
1180 #
1181
1182 # Scalar context: true/false
1183 # Array context: (\@added, \@deleted)
1184void
1185update(self)
1186	SV* self;
1187PREINIT:
1188	MAGIC		*mg;
1189	kstat_ctl_t	*kc;
1190	kstat_t		*kp;
1191	int		ret;
1192	AV		*add, *del;
1193PPCODE:
1194	/* Find the hidden KstatInfo_t structure */
1195	mg = mg_find(SvRV(self), '~');
1196	PERL_ASSERTMSG(mg != 0, "update: lost ~ magic");
1197	kc = *(kstat_ctl_t **)SvPVX(mg->mg_obj);
1198
1199	/* Update the kstat chain, and return immediately on error. */
1200	if ((ret = kstat_chain_update(kc)) == -1) {
1201		if (GIMME_V == G_ARRAY) {
1202			EXTEND(SP, 2);
1203			PUSHs(sv_newmortal());
1204			PUSHs(sv_newmortal());
1205		} else {
1206			EXTEND(SP, 1);
1207			PUSHs(sv_2mortal(newSViv(ret)));
1208		}
1209	}
1210
1211	/* Create the arrays to be returned if in an array context */
1212	if (GIMME_V == G_ARRAY) {
1213		add = newAV();
1214		del = newAV();
1215	} else {
1216		add = 0;
1217		del = 0;
1218	}
1219
1220	/*
1221	 * If the kstat chain hasn't changed we can just reread any stats
1222	 * that have already been read
1223	 */
1224	if (ret == 0) {
1225		if (! apply_to_ties(self, read_kstats_wrap, (void *)TRUE)) {
1226			if (GIMME_V == G_ARRAY) {
1227				EXTEND(SP, 2);
1228				PUSHs(sv_2mortal(newRV_noinc((SV *)add)));
1229				PUSHs(sv_2mortal(newRV_noinc((SV *)del)));
1230			} else {
1231				EXTEND(SP, 1);
1232				PUSHs(sv_2mortal(newSViv(-1)));
1233			}
1234		}
1235
1236	/*
1237	 * Otherwise we have to update the Perl structure so that it is in
1238	 * agreement with the new kstat chain.  We do this in such a way as to
1239	 * retain all the existing structures, just adding or deleting the
1240	 * bare minimum.
1241	 */
1242	} else {
1243		KstatInfo_t	kstatinfo;
1244
1245		/*
1246		 * Step 1: set the 'invalid' flag on each entry
1247		 */
1248		apply_to_ties(self, &set_valid, (void *)FALSE);
1249
1250		/*
1251		 * Step 2: Set the 'valid' flag on all entries still in the
1252		 * kernel kstat chain
1253		 */
1254		kstatinfo.read		= FALSE;
1255		kstatinfo.valid		= TRUE;
1256		kstatinfo.kstat_ctl	= kc;
1257		for (kp = kc->kc_chain; kp != 0; kp = kp->ks_next) {
1258			int	new;
1259			HV	*tie;
1260
1261			/* Don't bother storing the kstat headers or types */
1262			if (strncmp(kp->ks_name, "kstat_", 6) == 0) {
1263				continue;
1264			}
1265
1266			/* Don't bother storing raw stats we don't understand */
1267			if (kp->ks_type == KSTAT_TYPE_RAW &&
1268			    lookup_raw_kstat_fn(kp->ks_module, kp->ks_name)
1269			    == 0) {
1270#ifdef REPORT_UNKNOWN
1271				(void) printf("Unknown kstat type %s:%d:%s "
1272				    "- %d of size %d\n", kp->ks_module,
1273				    kp->ks_instance, kp->ks_name,
1274				    kp->ks_ndata, kp->ks_data_size);
1275#endif
1276				continue;
1277			}
1278
1279			/* Find the tied hash associated with the kstat entry */
1280			tie = get_tie(self, kp->ks_module, kp->ks_instance,
1281			    kp->ks_name, &new);
1282
1283			/* If newly created store the associated kstat info */
1284			if (new) {
1285				SV *kstatsv;
1286
1287				/*
1288				 * Save the data necessary to read the kstat
1289				 * info on demand
1290				 */
1291				hv_store(tie, "class", 5,
1292				    newSVpv(kp->ks_class, 0), 0);
1293				hv_store(tie, "crtime", 6,
1294				    NEW_HRTIME(kp->ks_crtime), 0);
1295				kstatinfo.kstat = kp;
1296				kstatsv = newSVpv((char *)&kstatinfo,
1297				    sizeof (kstatinfo));
1298				sv_magic((SV *)tie, kstatsv, '~', 0, 0);
1299				SvREFCNT_dec(kstatsv);
1300
1301				/* Save the key on the add list, if required */
1302				if (GIMME_V == G_ARRAY) {
1303					av_push(add, newSVpvf("%s:%d:%s",
1304					    kp->ks_module, kp->ks_instance,
1305					    kp->ks_name));
1306				}
1307
1308			/* If the stats already exist, just update them */
1309			} else {
1310				MAGIC *mg;
1311				KstatInfo_t *kip;
1312
1313				/* Find the hidden KstatInfo_t */
1314				mg = mg_find((SV *)tie, '~');
1315				PERL_ASSERTMSG(mg != 0, "update: lost ~ magic");
1316				kip = (KstatInfo_t *)SvPVX(mg->mg_obj);
1317
1318				/* Mark the tie as valid */
1319				kip->valid = TRUE;
1320
1321				/* Re-save the kstat_t pointer.  If the kstat
1322				 * has been deleted and re-added since the last
1323				 * update, the address of the kstat structure
1324				 * will have changed, even though the kstat will
1325				 * still live at the same place in the perl
1326				 * hash tree structure.
1327				 */
1328				kip->kstat = kp;
1329
1330				/* Reread the stats, if read previously */
1331				read_kstats(tie, TRUE);
1332			}
1333		}
1334
1335		/*
1336		 *Step 3: Delete any entries still marked as 'invalid'
1337		 */
1338		ret = prune_invalid(self, del);
1339
1340	}
1341	if (GIMME_V == G_ARRAY) {
1342		EXTEND(SP, 2);
1343		PUSHs(sv_2mortal(newRV_noinc((SV *)add)));
1344		PUSHs(sv_2mortal(newRV_noinc((SV *)del)));
1345	} else {
1346		EXTEND(SP, 1);
1347		PUSHs(sv_2mortal(newSViv(ret)));
1348	}
1349
1350
1351 #
1352 # Destructor.  Closes the kstat connection
1353 #
1354
1355void
1356DESTROY(self)
1357	SV *self;
1358PREINIT:
1359	MAGIC		*mg;
1360	kstat_ctl_t	*kc;
1361CODE:
1362	mg = mg_find(SvRV(self), '~');
1363	PERL_ASSERTMSG(mg != 0, "DESTROY: lost ~ magic");
1364	kc = *(kstat_ctl_t **)SvPVX(mg->mg_obj);
1365	if (kstat_close(kc) != 0) {
1366		croak(DEBUG_ID ": kstat_close: failed");
1367	}
1368
1369 #
1370 # The following XS methods implement the TIEHASH mechanism used to update the
1371 # kstats hash structure.  These are blessed into a package that isn't
1372 # visible to callers of the Sun::Solaris::Kstat module
1373 #
1374
1375MODULE = Sun::Solaris::Kstat PACKAGE = Sun::Solaris::Kstat::_Stat
1376PROTOTYPES: ENABLE
1377
1378 #
1379 # If a value has already been read, return it.  Otherwise read the appropriate
1380 # kstat and then return the value
1381 #
1382
1383SV*
1384FETCH(self, key)
1385	SV* self;
1386	SV* key;
1387PREINIT:
1388	char	*k;
1389	STRLEN	klen;
1390	SV	**value;
1391CODE:
1392	self = SvRV(self);
1393	k = SvPV(key, klen);
1394	if (strNE(k, "class") && strNE(k, "crtime")) {
1395		read_kstats((HV *)self, FALSE);
1396	}
1397	value = hv_fetch((HV *)self, k, klen, FALSE);
1398	if (value) {
1399		RETVAL = *value; SvREFCNT_inc(RETVAL);
1400	} else {
1401		RETVAL = &PL_sv_undef;
1402	}
1403OUTPUT:
1404	RETVAL
1405
1406 #
1407 # Save the passed value into the kstat hash.  Read the appropriate kstat first,
1408 # if necessary.  Note that this DOES NOT update the underlying kernel kstat
1409 # structure.
1410 #
1411
1412SV*
1413STORE(self, key, value)
1414	SV* self;
1415	SV* key;
1416	SV* value;
1417PREINIT:
1418	char	*k;
1419	STRLEN	klen;
1420CODE:
1421	self = SvRV(self);
1422	k = SvPV(key, klen);
1423	if (strNE(k, "class") && strNE(k, "crtime")) {
1424		read_kstats((HV *)self, FALSE);
1425	}
1426	SvREFCNT_inc(value);
1427	RETVAL = *(hv_store((HV *)self, k, klen, value, 0));
1428	SvREFCNT_inc(RETVAL);
1429OUTPUT:
1430	RETVAL
1431
1432 #
1433 # Check for the existence of the passed key.  Read the kstat first if necessary
1434 #
1435
1436bool
1437EXISTS(self, key)
1438	SV* self;
1439	SV* key;
1440PREINIT:
1441	char *k;
1442CODE:
1443	self = SvRV(self);
1444	k = SvPV(key, PL_na);
1445	if (strNE(k, "class") && strNE(k, "crtime")) {
1446		read_kstats((HV *)self, FALSE);
1447	}
1448	RETVAL = hv_exists_ent((HV *)self, key, 0);
1449OUTPUT:
1450	RETVAL
1451
1452
1453 #
1454 # Hash iterator initialisation.  Read the kstats if necessary.
1455 #
1456
1457SV*
1458FIRSTKEY(self)
1459	SV* self;
1460PREINIT:
1461	HE *he;
1462PPCODE:
1463	self = SvRV(self);
1464	read_kstats((HV *)self, FALSE);
1465	hv_iterinit((HV *)self);
1466	if ((he = hv_iternext((HV *)self))) {
1467		EXTEND(SP, 1);
1468		PUSHs(hv_iterkeysv(he));
1469	}
1470
1471 #
1472 # Return hash iterator next value.  Read the kstats if necessary.
1473 #
1474
1475SV*
1476NEXTKEY(self, lastkey)
1477	SV* self;
1478	SV* lastkey;
1479PREINIT:
1480	HE *he;
1481PPCODE:
1482	self = SvRV(self);
1483	if ((he = hv_iternext((HV *)self))) {
1484		EXTEND(SP, 1);
1485		PUSHs(hv_iterkeysv(he));
1486	}
1487
1488
1489 #
1490 # Delete the specified hash entry.
1491 #
1492
1493SV*
1494DELETE(self, key)
1495	SV *self;
1496	SV *key;
1497CODE:
1498	self = SvRV(self);
1499	RETVAL = hv_delete_ent((HV *)self, key, 0, 0);
1500	if (RETVAL) {
1501		SvREFCNT_inc(RETVAL);
1502	} else {
1503		RETVAL = &PL_sv_undef;
1504	}
1505OUTPUT:
1506	RETVAL
1507
1508 #
1509 # Clear the entire hash.  This will stop any update() calls rereading this
1510 # kstat until it is accessed again.
1511 #
1512
1513void
1514CLEAR(self)
1515	SV* self;
1516PREINIT:
1517	MAGIC   *mg;
1518	KstatInfo_t *kip;
1519CODE:
1520	self = SvRV(self);
1521	hv_clear((HV *)self);
1522	mg = mg_find(self, '~');
1523	PERL_ASSERTMSG(mg != 0, "CLEAR: lost ~ magic");
1524	kip = (KstatInfo_t *)SvPVX(mg->mg_obj);
1525	kip->read  = FALSE;
1526	kip->valid = TRUE;
1527	hv_store((HV *)self, "class", 5, newSVpv(kip->kstat->ks_class, 0), 0);
1528	hv_store((HV *)self, "crtime", 6, NEW_HRTIME(kip->kstat->ks_crtime), 0);
1529