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 */
25
26 /*
27 * Kstat.xs is a Perl XS (eXStension module) that makes the Solaris
28 * kstat(3KSTAT) facility available to Perl scripts. Kstat is a general-purpose
29 * mechanism for providing kernel statistics to users. The Solaris API is
30 * function-based (see the manpage for details), but for ease of use in Perl
31 * scripts this module presents the information as a nested hash data structure.
32 * It would be too inefficient to read every kstat in the system, so this module
33 * uses the Perl TIEHASH mechanism to implement a read-on-demand semantic, which
34 * only reads and updates kstats as and when they are actually accessed.
35 */
36
37 /*
38 * Ignored raw kstats.
39 *
40 * Some raw kstats are ignored by this module, these are listed below. The
41 * most common reason is that the kstats are stored as arrays and the ks_ndata
42 * and/or ks_data_size fields are invalid. In this case it is impossible to
43 * know how many records are in the array, so they can't be read.
877 PERL_ASSERTMSG(mg != 0, "get_tie: lost P magic");
878 tie = (HV *)SvRV(mg->mg_obj);
879 }
880 if (is_new) {
881 *is_new = new;
882 }
883 return (tie);
884 }
885
886 /*
887 * This is an iterator function used to traverse the hash hierarchy and apply
888 * the passed function to the tied hashes at the bottom of the hierarchy. If
889 * any of the callback functions return 0, 0 is returned, otherwise 1
890 */
891
892 static int
893 apply_to_ties(SV *self, ATTCb_t cb, void *arg)
894 {
895 HV *hash1;
896 HE *entry1;
897 long s;
898 int ret;
899
900 hash1 = (HV *)SvRV(self);
901 hv_iterinit(hash1);
902 ret = 1;
903
904 /* Iterate over each module */
905 while (entry1 = hv_iternext(hash1)) {
906 HV *hash2;
907 HE *entry2;
908
909 hash2 = (HV *)SvRV(hv_iterval(hash1, entry1));
910 hv_iterinit(hash2);
911
912 /* Iterate over each module:instance */
913 while (entry2 = hv_iternext(hash2)) {
914 HV *hash3;
915 HE *entry3;
916
917 hash3 = (HV *)SvRV(hv_iterval(hash2, entry2));
918 hv_iterinit(hash3);
919
920 /* Iterate over each module:instance:name */
921 while (entry3 = hv_iternext(hash3)) {
922 HV *hash4;
923 MAGIC *mg;
924 HV *tie;
925
926 /* Get the tie */
927 hash4 = (HV *)SvRV(hv_iterval(hash3, entry3));
928 mg = mg_find((SV *)hash4, 'P');
929 PERL_ASSERTMSG(mg != 0,
930 "apply_to_ties: lost P magic");
931
932 /* Apply the callback */
933 if (! cb((HV *)SvRV(mg->mg_obj), arg)) {
934 ret = 0;
935 }
936 }
937 }
938 }
939 return (ret);
940 }
941
942 /*
943 * Mark this HV as valid - used by update() when pruning deleted kstat nodes
944 */
959 * that the kstat chain has been updated. This removes any hash tree entries
960 * that no longer have a corresponding kstat. If del is non-null it will be
961 * set to the keys of the deleted kstat nodes, if any. If any entries are
962 * deleted 1 will be retured, otherwise 0
963 */
964
965 static int
966 prune_invalid(SV *self, AV *del)
967 {
968 HV *hash1;
969 HE *entry1;
970 STRLEN klen;
971 char *module, *instance, *name, *key;
972 int ret;
973
974 hash1 = (HV *)SvRV(self);
975 hv_iterinit(hash1);
976 ret = 0;
977
978 /* Iterate over each module */
979 while (entry1 = hv_iternext(hash1)) {
980 HV *hash2;
981 HE *entry2;
982
983 module = HePV(entry1, PL_na);
984 hash2 = (HV *)SvRV(hv_iterval(hash1, entry1));
985 hv_iterinit(hash2);
986
987 /* Iterate over each module:instance */
988 while (entry2 = hv_iternext(hash2)) {
989 HV *hash3;
990 HE *entry3;
991
992 instance = HePV(entry2, PL_na);
993 hash3 = (HV *)SvRV(hv_iterval(hash2, entry2));
994 hv_iterinit(hash3);
995
996 /* Iterate over each module:instance:name */
997 while (entry3 = hv_iternext(hash3)) {
998 HV *hash4;
999 MAGIC *mg;
1000 HV *tie;
1001
1002 name = HePV(entry3, PL_na);
1003 hash4 = (HV *)SvRV(hv_iterval(hash3, entry3));
1004 mg = mg_find((SV *)hash4, 'P');
1005 PERL_ASSERTMSG(mg != 0,
1006 "prune_invalid: lost P magic");
1007 tie = (HV *)SvRV(mg->mg_obj);
1008 mg = mg_find((SV *)tie, '~');
1009 PERL_ASSERTMSG(mg != 0,
1010 "prune_invalid: lost ~ magic");
1011
1012 /* If this is marked as invalid, prune it */
1013 if (((KstatInfo_t *)SvPVX(
1014 (SV *)mg->mg_obj))->valid == FALSE) {
1015 SvREADONLY_off(hash3);
1016 key = HePV(entry3, klen);
1017 hv_delete(hash3, key, klen, G_DISCARD);
1067 value = newSViv(knp->value.i32);
1068 break;
1069 case KSTAT_DATA_UINT32:
1070 value = NEW_UV(knp->value.ui32);
1071 break;
1072 case KSTAT_DATA_INT64:
1073 value = NEW_UV(knp->value.i64);
1074 break;
1075 case KSTAT_DATA_UINT64:
1076 value = NEW_UV(knp->value.ui64);
1077 break;
1078 case KSTAT_DATA_STRING:
1079 if (KSTAT_NAMED_STR_PTR(knp) == NULL)
1080 value = newSVpv("null", sizeof ("null") - 1);
1081 else
1082 value = newSVpv(KSTAT_NAMED_STR_PTR(knp),
1083 KSTAT_NAMED_STR_BUFLEN(knp) -1);
1084 break;
1085 default:
1086 PERL_ASSERTMSG(0, "kstat_read: invalid data type");
1087 break;
1088 }
1089 hv_store(self, knp->name, strlen(knp->name), value, 0);
1090 }
1091 }
1092
1093 /*
1094 * Save kstat interrupt statistics
1095 */
1096
1097 static void
1098 save_intr(HV *self, kstat_t *kp, int strip_str)
1099 {
1100 kstat_intr_t *kintrp;
1101 int i;
1102 static char *intr_names[] =
1103 { "hard", "soft", "watchdog", "spurious", "multiple_service" };
1104
1105 PERL_ASSERT(kp->ks_ndata == 1);
1106 PERL_ASSERT(kp->ks_data_size == sizeof (kstat_intr_t));
1107 kintrp = KSTAT_INTR_PTR(kp);
1608 read_kstats((HV *)self, FALSE);
1609 }
1610 RETVAL = hv_exists_ent((HV *)self, key, 0);
1611 OUTPUT:
1612 RETVAL
1613
1614
1615 #
1616 # Hash iterator initialisation. Read the kstats if necessary.
1617 #
1618
1619 SV*
1620 FIRSTKEY(self)
1621 SV* self;
1622 PREINIT:
1623 HE *he;
1624 PPCODE:
1625 self = SvRV(self);
1626 read_kstats((HV *)self, FALSE);
1627 hv_iterinit((HV *)self);
1628 if (he = hv_iternext((HV *)self)) {
1629 EXTEND(SP, 1);
1630 PUSHs(hv_iterkeysv(he));
1631 }
1632
1633 #
1634 # Return hash iterator next value. Read the kstats if necessary.
1635 #
1636
1637 SV*
1638 NEXTKEY(self, lastkey)
1639 SV* self;
1640 SV* lastkey;
1641 PREINIT:
1642 HE *he;
1643 PPCODE:
1644 self = SvRV(self);
1645 if (he = hv_iternext((HV *)self)) {
1646 EXTEND(SP, 1);
1647 PUSHs(hv_iterkeysv(he));
1648 }
1649
1650
1651 #
1652 # Delete the specified hash entry.
1653 #
1654
1655 SV*
1656 DELETE(self, key)
1657 SV *self;
1658 SV *key;
1659 CODE:
1660 self = SvRV(self);
1661 RETVAL = hv_delete_ent((HV *)self, key, 0, 0);
1662 if (RETVAL) {
1663 SvREFCNT_inc(RETVAL);
1664 } else {
1665 RETVAL = &PL_sv_undef;
|
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.
878 PERL_ASSERTMSG(mg != 0, "get_tie: lost P magic");
879 tie = (HV *)SvRV(mg->mg_obj);
880 }
881 if (is_new) {
882 *is_new = new;
883 }
884 return (tie);
885 }
886
887 /*
888 * This is an iterator function used to traverse the hash hierarchy and apply
889 * the passed function to the tied hashes at the bottom of the hierarchy. If
890 * any of the callback functions return 0, 0 is returned, otherwise 1
891 */
892
893 static int
894 apply_to_ties(SV *self, ATTCb_t cb, void *arg)
895 {
896 HV *hash1;
897 HE *entry1;
898 int ret;
899
900 hash1 = (HV *)SvRV(self);
901 hv_iterinit(hash1);
902 ret = 1;
903
904 /* Iterate over each module */
905 while ((entry1 = hv_iternext(hash1))) {
906 HV *hash2;
907 HE *entry2;
908
909 hash2 = (HV *)SvRV(hv_iterval(hash1, entry1));
910 hv_iterinit(hash2);
911
912 /* Iterate over each module:instance */
913 while ((entry2 = hv_iternext(hash2))) {
914 HV *hash3;
915 HE *entry3;
916
917 hash3 = (HV *)SvRV(hv_iterval(hash2, entry2));
918 hv_iterinit(hash3);
919
920 /* Iterate over each module:instance:name */
921 while ((entry3 = hv_iternext(hash3))) {
922 HV *hash4;
923 MAGIC *mg;
924
925 /* Get the tie */
926 hash4 = (HV *)SvRV(hv_iterval(hash3, entry3));
927 mg = mg_find((SV *)hash4, 'P');
928 PERL_ASSERTMSG(mg != 0,
929 "apply_to_ties: lost P magic");
930
931 /* Apply the callback */
932 if (! cb((HV *)SvRV(mg->mg_obj), arg)) {
933 ret = 0;
934 }
935 }
936 }
937 }
938 return (ret);
939 }
940
941 /*
942 * Mark this HV as valid - used by update() when pruning deleted kstat nodes
943 */
958 * that the kstat chain has been updated. This removes any hash tree entries
959 * that no longer have a corresponding kstat. If del is non-null it will be
960 * set to the keys of the deleted kstat nodes, if any. If any entries are
961 * deleted 1 will be retured, otherwise 0
962 */
963
964 static int
965 prune_invalid(SV *self, AV *del)
966 {
967 HV *hash1;
968 HE *entry1;
969 STRLEN klen;
970 char *module, *instance, *name, *key;
971 int ret;
972
973 hash1 = (HV *)SvRV(self);
974 hv_iterinit(hash1);
975 ret = 0;
976
977 /* Iterate over each module */
978 while ((entry1 = hv_iternext(hash1))) {
979 HV *hash2;
980 HE *entry2;
981
982 module = HePV(entry1, PL_na);
983 hash2 = (HV *)SvRV(hv_iterval(hash1, entry1));
984 hv_iterinit(hash2);
985
986 /* Iterate over each module:instance */
987 while ((entry2 = hv_iternext(hash2))) {
988 HV *hash3;
989 HE *entry3;
990
991 instance = HePV(entry2, PL_na);
992 hash3 = (HV *)SvRV(hv_iterval(hash2, entry2));
993 hv_iterinit(hash3);
994
995 /* Iterate over each module:instance:name */
996 while ((entry3 = hv_iternext(hash3))) {
997 HV *hash4;
998 MAGIC *mg;
999 HV *tie;
1000
1001 name = HePV(entry3, PL_na);
1002 hash4 = (HV *)SvRV(hv_iterval(hash3, entry3));
1003 mg = mg_find((SV *)hash4, 'P');
1004 PERL_ASSERTMSG(mg != 0,
1005 "prune_invalid: lost P magic");
1006 tie = (HV *)SvRV(mg->mg_obj);
1007 mg = mg_find((SV *)tie, '~');
1008 PERL_ASSERTMSG(mg != 0,
1009 "prune_invalid: lost ~ magic");
1010
1011 /* If this is marked as invalid, prune it */
1012 if (((KstatInfo_t *)SvPVX(
1013 (SV *)mg->mg_obj))->valid == FALSE) {
1014 SvREADONLY_off(hash3);
1015 key = HePV(entry3, klen);
1016 hv_delete(hash3, key, klen, G_DISCARD);
1066 value = newSViv(knp->value.i32);
1067 break;
1068 case KSTAT_DATA_UINT32:
1069 value = NEW_UV(knp->value.ui32);
1070 break;
1071 case KSTAT_DATA_INT64:
1072 value = NEW_UV(knp->value.i64);
1073 break;
1074 case KSTAT_DATA_UINT64:
1075 value = NEW_UV(knp->value.ui64);
1076 break;
1077 case KSTAT_DATA_STRING:
1078 if (KSTAT_NAMED_STR_PTR(knp) == NULL)
1079 value = newSVpv("null", sizeof ("null") - 1);
1080 else
1081 value = newSVpv(KSTAT_NAMED_STR_PTR(knp),
1082 KSTAT_NAMED_STR_BUFLEN(knp) -1);
1083 break;
1084 default:
1085 PERL_ASSERTMSG(0, "kstat_read: invalid data type");
1086 continue;
1087 }
1088 hv_store(self, knp->name, strlen(knp->name), value, 0);
1089 }
1090 }
1091
1092 /*
1093 * Save kstat interrupt statistics
1094 */
1095
1096 static void
1097 save_intr(HV *self, kstat_t *kp, int strip_str)
1098 {
1099 kstat_intr_t *kintrp;
1100 int i;
1101 static char *intr_names[] =
1102 { "hard", "soft", "watchdog", "spurious", "multiple_service" };
1103
1104 PERL_ASSERT(kp->ks_ndata == 1);
1105 PERL_ASSERT(kp->ks_data_size == sizeof (kstat_intr_t));
1106 kintrp = KSTAT_INTR_PTR(kp);
1607 read_kstats((HV *)self, FALSE);
1608 }
1609 RETVAL = hv_exists_ent((HV *)self, key, 0);
1610 OUTPUT:
1611 RETVAL
1612
1613
1614 #
1615 # Hash iterator initialisation. Read the kstats if necessary.
1616 #
1617
1618 SV*
1619 FIRSTKEY(self)
1620 SV* self;
1621 PREINIT:
1622 HE *he;
1623 PPCODE:
1624 self = SvRV(self);
1625 read_kstats((HV *)self, FALSE);
1626 hv_iterinit((HV *)self);
1627 if ((he = hv_iternext((HV *)self))) {
1628 EXTEND(SP, 1);
1629 PUSHs(hv_iterkeysv(he));
1630 }
1631
1632 #
1633 # Return hash iterator next value. Read the kstats if necessary.
1634 #
1635
1636 SV*
1637 NEXTKEY(self, lastkey)
1638 SV* self;
1639 SV* lastkey;
1640 PREINIT:
1641 HE *he;
1642 PPCODE:
1643 self = SvRV(self);
1644 if ((he = hv_iternext((HV *)self))) {
1645 EXTEND(SP, 1);
1646 PUSHs(hv_iterkeysv(he));
1647 }
1648
1649
1650 #
1651 # Delete the specified hash entry.
1652 #
1653
1654 SV*
1655 DELETE(self, key)
1656 SV *self;
1657 SV *key;
1658 CODE:
1659 self = SvRV(self);
1660 RETVAL = hv_delete_ent((HV *)self, key, 0, 0);
1661 if (RETVAL) {
1662 SvREFCNT_inc(RETVAL);
1663 } else {
1664 RETVAL = &PL_sv_undef;
|