lists.openwall.net   lists  /  announce  owl-users  owl-dev  john-users  john-dev  passwdqc-users  yescrypt  popa3d-users  /  oss-security  kernel-hardening  musl  sabotage  tlsify  passwords  /  crypt-dev  xvendor  /  Bugtraq  Full-Disclosure  linux-kernel  linux-netdev  linux-ext4  linux-hardening  linux-cve-announce  PHC 
Open Source and information security mailing list archives
 
Hash Suite: Windows password security audit tool. GUI, reports in PDF.
[<prev] [next>] [<thread-prev] [thread-next>] [day] [month] [year] [list]
Date:	Wed, 27 Jan 2010 02:28:02 -0600
From:	Tom Zanussi <tzanussi@...il.com>
To:	linux-kernel@...r.kernel.org
Cc:	mingo@...e.hu, fweisbec@...il.com, rostedt@...dmis.org,
	k-keiichi@...jp.nec.com
Subject: [PATCH 11/12] perf trace/scripting: make the syscall map available as a Perl hash

Create a Perl extension that makes the perf syscall map into a
Perl hash.

New instances of the syscall hash can be retrieved at any time by by
calling the Perl function get_syscall_names().  This is a hash
reference, so use hash reference syntax to access its contents.

Also adds a new utility function that makes uses of the syscall name
dict:

syscall_name($syscall_nr);

which returns a syscall name given a syscall_nr, or the number itself
if the syscall wasn't found in the map (or 'undefined' if the value
passed in was bogus).

Signed-off-by: Tom Zanussi <tzanussi@...il.com>
---
 tools/perf/scripts/perl/Perf-Trace-Util/Context.c  |   46 +++++++++++++++++++-
 tools/perf/scripts/perl/Perf-Trace-Util/Context.xs |   24 ++++++++++
 .../perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm |    2 +-
 .../perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm    |   22 +++++++++-
 tools/perf/scripts/perl/failed-syscalls.pl         |   15 ++++++-
 5 files changed, 105 insertions(+), 4 deletions(-)

diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/Context.c b/tools/perf/scripts/perl/Perf-Trace-Util/Context.c
index 01a64ad..ae2279d 100644
--- a/tools/perf/scripts/perl/Perf-Trace-Util/Context.c
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/Context.c
@@ -34,11 +34,32 @@
 #include "../../../perf.h"
 #include "../../../util/trace-event.h"
 
+static HV *get_syscall_names(void)
+{
+	const struct syscall_metadata *meta;
+	char buf[8];
+	HV *hash;
+	int i;
+
+	hash = (HV *)sv_2mortal((SV *)newHV());
+	if (!hash)
+		return NULL;
+
+	for (i = 0; i < nr_syscalls(); i++) {
+		meta  = syscall_at_idx(i);
+		sprintf(buf, "%d", meta->nr);
+		(void) hv_store(hash, buf, strlen(buf),
+		       newSVpv(meta->name, 0), 0);
+	}
+
+	return hash;
+}
+
 #ifndef PERL_UNUSED_VAR
 #  define PERL_UNUSED_VAR(var) if (0) var = var
 #endif
 
-#line 42 "Context.c"
+#line 63 "Context.c"
 
 XS(XS_Perf__Trace__Context_common_pc); /* prototype to pass -Wmissing-prototypes */
 XS(XS_Perf__Trace__Context_common_pc)
@@ -108,6 +129,28 @@ XS(XS_Perf__Trace__Context_common_lock_depth)
     XSRETURN(1);
 }
 
+
+XS(XS_Perf__Trace__Context_get_syscall_names); /* prototype to pass -Wmissing-prototypes */
+XS(XS_Perf__Trace__Context_get_syscall_names)
+{
+#ifdef dVAR
+    dVAR; dXSARGS;
+#else
+    dXSARGS;
+#endif
+    if (items != 0)
+       Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::get_syscall_names", "");
+    PERL_UNUSED_VAR(cv); /* -W */
+    {
+	HV *	RETVAL;
+
+	RETVAL = get_syscall_names();
+	ST(0) = newRV((SV*)RETVAL);
+	sv_2mortal(ST(0));
+    }
+    XSRETURN(1);
+}
+
 #ifdef __cplusplus
 extern "C"
 #endif
@@ -128,6 +171,7 @@ XS(boot_Perf__Trace__Context)
         newXSproto("Perf::Trace::Context::common_pc", XS_Perf__Trace__Context_common_pc, file, "$");
         newXSproto("Perf::Trace::Context::common_flags", XS_Perf__Trace__Context_common_flags, file, "$");
         newXSproto("Perf::Trace::Context::common_lock_depth", XS_Perf__Trace__Context_common_lock_depth, file, "$");
+        newXSproto("Perf::Trace::Context::get_syscall_names", XS_Perf__Trace__Context_get_syscall_names, file, "");
     if (PL_unitcheckav)
          call_list(PL_scopestack_ix, PL_unitcheckav);
     XSRETURN_YES;
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/Context.xs b/tools/perf/scripts/perl/Perf-Trace-Util/Context.xs
index 549cf04..d016473 100644
--- a/tools/perf/scripts/perl/Perf-Trace-Util/Context.xs
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/Context.xs
@@ -25,6 +25,27 @@
 #include "../../../perf.h"
 #include "../../../util/trace-event.h"
 
+static HV *get_syscall_names(void)
+{
+	const struct syscall_metadata *meta;
+	char buf[8];
+	HV *hash;
+	int i;
+
+	hash = (HV *)sv_2mortal((SV *)newHV());
+	if (!hash)
+		return NULL;
+
+	for (i = 0; i < nr_syscalls(); i++) {
+		meta  = syscall_at_idx(i);
+		sprintf(buf, "%d", meta->nr);
+		(void) hv_store(hash, buf, strlen(buf),
+		       newSVpv(meta->name, 0), 0);
+	}
+
+	return hash;
+}
+
 MODULE = Perf::Trace::Context		PACKAGE = Perf::Trace::Context
 PROTOTYPES: ENABLE
 
@@ -40,3 +61,6 @@ int
 common_lock_depth(context)
 	struct scripting_context * context
 
+HV *
+get_syscall_names()
+
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm
index 6c7f365..dc2231e 100644
--- a/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm
@@ -14,7 +14,7 @@ our %EXPORT_TAGS = ( 'all' => [ qw(
 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
 
 our @EXPORT = qw(
-	common_pc common_flags common_lock_depth
+	common_pc common_flags common_lock_depth get_syscall_names
 );
 
 our $VERSION = '0.01';
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm
index f869c48..d62314b 100644
--- a/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm
@@ -4,6 +4,9 @@ use 5.010000;
 use strict;
 use warnings;
 
+use Perf::Trace::Core;
+use Perf::Trace::Context;
+
 require Exporter;
 
 our @ISA = qw(Exporter);
@@ -14,7 +17,7 @@ our %EXPORT_TAGS = ( 'all' => [ qw(
 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
 
 our @EXPORT = qw(
-avg nsecs nsecs_secs nsecs_nsecs nsecs_usecs print_nsecs
+avg nsecs nsecs_secs nsecs_nsecs nsecs_usecs print_nsecs syscall_name
 );
 
 our $VERSION = '0.01';
@@ -55,6 +58,23 @@ sub nsecs_str {
     return $str;
 }
 
+my $syscall_name_map = get_syscall_names();
+
+sub syscall_name
+{
+	my ($id) = @_;
+
+	if ($id == -1) {
+	    return "undefined"
+	}
+
+	if ($syscall_name_map->{$id}) {
+	    return $syscall_name_map->{$id};
+	} else {
+	    return $id;
+	}
+}
+
 1;
 __END__
 =head1 NAME
diff --git a/tools/perf/scripts/perl/failed-syscalls.pl b/tools/perf/scripts/perl/failed-syscalls.pl
index c18e7e2..eeaaa28 100644
--- a/tools/perf/scripts/perl/failed-syscalls.pl
+++ b/tools/perf/scripts/perl/failed-syscalls.pl
@@ -12,6 +12,7 @@ use Perf::Trace::Context;
 use Perf::Trace::Util;
 
 my %failed_syscalls;
+my %failed_syscall_ids;
 
 sub raw_syscalls::sys_exit
 {
@@ -21,12 +22,13 @@ sub raw_syscalls::sys_exit
 
 	if ($ret < 0) {
 	    $failed_syscalls{$common_comm}++;
+	    $failed_syscall_ids{$id}++;
 	}
 }
 
 sub trace_end
 {
-    printf("\nfailed syscalls by comm:\n\n");
+    printf("\nfailed syscalls, by comm:\n\n");
 
     printf("%-20s  %10s\n", "comm", "# errors");
     printf("%-20s  %6s  %10s\n", "--------------------", "----------");
@@ -35,4 +37,15 @@ sub trace_end
 		      keys %failed_syscalls) {
 	    printf("%-20s  %10s\n", $comm, $failed_syscalls{$comm});
     }
+
+    printf("\n\nfailed syscalls, by syscall:\n\n");
+
+    printf("%-30s  %10s\n", "syscall", "# errors");
+    printf("%-30s  %6s  %10s\n", "------------------------------",
+	   "----------");
+
+    foreach my $id (sort {$failed_syscall_ids{$b} <=> $failed_syscall_ids{$a}}
+		    keys %failed_syscall_ids) {
+	printf("%-30s  %10d\n", syscall_name($id), $failed_syscall_ids{$id});
+    }
 }
-- 
1.6.4.GIT

--
To unsubscribe from this list: send the line "unsubscribe linux-kernel" in
the body of a message to majordomo@...r.kernel.org
More majordomo info at  http://vger.kernel.org/majordomo-info.html
Please read the FAQ at  http://www.tux.org/lkml/

Powered by blists - more mailing lists

Powered by Openwall GNU/*/Linux Powered by OpenVZ