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 for Android: free password hash cracker in your pocket
[<prev] [next>] [<thread-prev] [thread-next>] [day] [month] [year] [list]
Date:	Tue, 29 Mar 2016 13:07:44 -0300
From:	Arnaldo Carvalho de Melo <acme@...nel.org>
To:	Dima Kogan <dima@...retsauce.net>
Cc:	linux-kernel@...r.kernel.org
Subject: Re: [PATCH] perf: perl scripts now get a backtrace, like the python
 scripts

Em Tue, Mar 29, 2016 at 02:25:47AM -0700, Dima Kogan escreveu:
> Arnaldo Carvalho de Melo <acme@...nel.org> writes:
> 
> > Em Fri, Mar 25, 2016 at 11:31:54AM -0700, Dima Kogan escreveu:
> >> Hi.
> >> 
> >> Currently the python perf scripts get a backtrace, while the perl ones do not.
> >> This patch adds that to the perl scripts as well.
> >
> > Can you send as a single message, with your Signed-off-by, and with an
> > example of this in use? I.e. a simple perl script that used with 'perf
> > script' exercises this new code, so that we can see, in the changeset
> > log message how this is used, etc?
> >
> > Please take a look at Documentation/SubmittingPatches.
> 
> OK. Here's the patch again with the changes you requested in the
> message.

Thanks, with a bit more twiddling I got it merged, hint: don't send
attachments.

I tested it and it seems to work, thanks for doing this.

- Arnaldo

> >From 652bdf06f613c12f65eee294539bb0259abeceda Mon Sep 17 00:00:00 2001
> From: Dima Kogan <dima@...retsauce.net>
> Date: Fri, 25 Mar 2016 11:31:54 -0700
> Subject: [PATCH] perf: perl scripts now get a backtrace, like the python
>  scripts
> 
> We have some infrastructure to use perl or python to analyze logs
> generated by perf.  Prior to this patch, only the python tools had
> access to backtrace information.  This patch makes this information
> available to perl scripts as well.  Example:
> 
>   Let's look at malloc() calls made by the seq utility.  First we
>   create a tracepoint
> 
>       $ perf probe -x /lib/x86_64-linux-gnu/libc.so.6 malloc
>       Added new events:
>       ...
> 
>   Now we run seq, while monitoring malloc() calls with perf
> 
>       $ perf record --call-graph=dwarf -e probe_libc:malloc seq 5
>       1
>       2
>       3
>       4
>       5
>       [ perf record: Woken up 1 times to write data ]
>       [ perf record: Captured and wrote 0.064 MB perf.data (6 samples) ]
> 
>   We can use perf to look at its log to see the malloc calls and the backtrace
> 
>       $ perf script
>       seq 14195 [000] 1927993.748254: probe_libc:malloc: (7f9ff8edd320) bytes=0x22
>                   7f9ff8edd320 malloc (/lib/x86_64-linux-gnu/libc-2.22.so)
>                   7f9ff8e8eab0 set_binding_values.part.0 (/lib/x86_64-linux-gnu/libc-2.22.so)
>                   7f9ff8e8eda1 __bindtextdomain (/lib/x86_64-linux-gnu/libc-2.22.so)
>                         401b22 main (/usr/bin/seq)
>                   7f9ff8e82610 __libc_start_main (/lib/x86_64-linux-gnu/libc-2.22.so)
>                         402799 _start (/usr/bin/seq)
>       ...
> 
>   We can also use the scripting facilities.  We create a skeleton perl
>   script that simply prints out the events
> 
>       $ perf script -g perl
>       generated Perl script: perf-script.pl
> 
>   We can then use this script to see the malloc() calls with a
>   backtrace.  Prior to this patch, the backtrace was not available to
>   the perl scripts.
> 
>       $ perf script -s perf-script.pl
>       probe_libc::malloc       0 1927993.748254260    14195 seq                  __probe_ip=140325052863264, bytes=34
>               [7f9ff8edd320] malloc
>               [7f9ff8e8eab0] set_binding_values.part.0
>               [7f9ff8e8eda1] __bindtextdomain
>               [401b22] main
>               [7f9ff8e82610] __libc_start_main
>               [402799] _start
>       ...
> 
> Signed-off-by: Dima Kogan <dima@...retsauce.net>
> ---
>  .../perf/util/scripting-engines/trace-event-perl.c | 114 +++++++++++++++++++--
>  1 file changed, 106 insertions(+), 8 deletions(-)
> 
> diff --git a/tools/perf/util/scripting-engines/trace-event-perl.c b/tools/perf/util/scripting-engines/trace-event-perl.c
> index 1bd593b..db3bb4b 100644
> --- a/tools/perf/util/scripting-engines/trace-event-perl.c
> +++ b/tools/perf/util/scripting-engines/trace-event-perl.c
> @@ -31,6 +31,8 @@
>  #include <perl.h>
>  
>  #include "../../perf.h"
> +#include "../callchain.h"
> +#include "../machine.h"
>  #include "../thread.h"
>  #include "../event.h"
>  #include "../trace-event.h"
> @@ -244,10 +246,78 @@ static void define_event_symbols(struct event_format *event,
>  		define_event_symbols(event, ev_name, args->next);
>  }
>  
> +static SV *perl_process_callchain(struct perf_sample *sample,
> +				  struct perf_evsel *evsel,
> +				  struct addr_location *al)
> +{
> +	AV *list;
> +
> +	list = newAV();
> +	if (!list)
> +		goto exit;
> +
> +	if (!symbol_conf.use_callchain || !sample->callchain)
> +		goto exit;
> +
> +	if (thread__resolve_callchain(al->thread, evsel,
> +				      sample, NULL, NULL,
> +				      PERF_MAX_STACK_DEPTH) != 0) {
> +		pr_err("Failed to resolve callchain. Skipping\n");
> +		goto exit;
> +	}
> +	callchain_cursor_commit(&callchain_cursor);
> +
> +
> +	while (1) {
> +		HV *elem;
> +		struct callchain_cursor_node *node;
> +		node = callchain_cursor_current(&callchain_cursor);
> +		if (!node)
> +			break;
> +
> +		elem = newHV();
> +		if (!elem)
> +			goto exit;
> +
> +		hv_stores(elem, "ip", newSVuv(node->ip));
> +
> +		if (node->sym) {
> +			HV *sym = newHV();
> +			if (!sym)
> +				goto exit;
> +			hv_stores(sym, "start",   newSVuv(node->sym->start));
> +			hv_stores(sym, "end",     newSVuv(node->sym->end));
> +			hv_stores(sym, "binding", newSVuv(node->sym->binding));
> +			hv_stores(sym, "name",    newSVpvn(node->sym->name,
> +							   node->sym->namelen));
> +			hv_stores(elem, "sym",    newRV_noinc((SV*)sym));
> +		}
> +
> +		if (node->map) {
> +			struct map *map = node->map;
> +			const char *dsoname = "[unknown]";
> +			if (map && map->dso && (map->dso->name || map->dso->long_name)) {
> +				if (symbol_conf.show_kernel_path && map->dso->long_name)
> +					dsoname = map->dso->long_name;
> +				else if (map->dso->name)
> +					dsoname = map->dso->name;
> +			}
> +			hv_stores(elem, "dso", newSVpv(dsoname,0));
> +		}
> +
> +		callchain_cursor_advance(&callchain_cursor);
> +		av_push(list, newRV_noinc((SV*)elem));
> +	}
> +
> +exit:
> +	return newRV_noinc((SV*)list);
> +}
> +
>  static void perl_process_tracepoint(struct perf_sample *sample,
>  				    struct perf_evsel *evsel,
> -				    struct thread *thread)
> +				    struct addr_location *al)
>  {
> +	struct thread *thread = al->thread;
>  	struct event_format *event = evsel->tp_format;
>  	struct format_field *field;
>  	static char handler[256];
> @@ -291,6 +361,7 @@ static void perl_process_tracepoint(struct perf_sample *sample,
>  	XPUSHs(sv_2mortal(newSVuv(ns)));
>  	XPUSHs(sv_2mortal(newSViv(pid)));
>  	XPUSHs(sv_2mortal(newSVpv(comm, 0)));
> +	XPUSHs(sv_2mortal(perl_process_callchain(sample, evsel, al)));
>  
>  	/* common fields other than pid can be accessed via xsub fns */
>  
> @@ -325,6 +396,7 @@ static void perl_process_tracepoint(struct perf_sample *sample,
>  		XPUSHs(sv_2mortal(newSVuv(nsecs)));
>  		XPUSHs(sv_2mortal(newSViv(pid)));
>  		XPUSHs(sv_2mortal(newSVpv(comm, 0)));
> +		XPUSHs(sv_2mortal(perl_process_callchain(sample, evsel, al)));
>  		call_pv("main::trace_unhandled", G_SCALAR);
>  	}
>  	SPAGAIN;
> @@ -362,7 +434,7 @@ static void perl_process_event(union perf_event *event,
>  			       struct perf_evsel *evsel,
>  			       struct addr_location *al)
>  {
> -	perl_process_tracepoint(sample, evsel, al->thread);
> +	perl_process_tracepoint(sample, evsel, al);
>  	perl_process_event_generic(event, sample, evsel);
>  }
>  
> @@ -486,7 +558,27 @@ static int perl_generate_script(struct pevent *pevent, const char *outfile)
>  	fprintf(ofp, "use Perf::Trace::Util;\n\n");
>  
>  	fprintf(ofp, "sub trace_begin\n{\n\t# optional\n}\n\n");
> -	fprintf(ofp, "sub trace_end\n{\n\t# optional\n}\n\n");
> +	fprintf(ofp, "sub trace_end\n{\n\t# optional\n}\n");
> +
> +
> +	fprintf(ofp, "\n\
> +sub print_backtrace\n\
> +{\n\
> +	my $callchain = shift;\n\
> +	for my $node (@$callchain)\n\
> +	{\n\
> +		if(exists $node->{sym})\n\
> +		{\n\
> +			printf( \"\\t[\\%%x] \\%%s\\n\", $node->{ip}, $node->{sym}{name});\n\
> +		}\n\
> +		else\n\
> +		{\n\
> +			printf( \"\\t[\\%%x]\\n\", $node{ip});\n\
> +		}\n\
> +	}\n\
> +}\n\n\
> +");
> +
>  
>  	while ((event = trace_find_next_event(pevent, event))) {
>  		fprintf(ofp, "sub %s::%s\n{\n", event->system, event->name);
> @@ -498,7 +590,8 @@ static int perl_generate_script(struct pevent *pevent, const char *outfile)
>  		fprintf(ofp, "$common_secs, ");
>  		fprintf(ofp, "$common_nsecs,\n");
>  		fprintf(ofp, "\t    $common_pid, ");
> -		fprintf(ofp, "$common_comm,\n\t    ");
> +		fprintf(ofp, "$common_comm, ");
> +		fprintf(ofp, "$common_callchain,\n\t    ");
>  
>  		not_first = 0;
>  		count = 0;
> @@ -515,7 +608,7 @@ static int perl_generate_script(struct pevent *pevent, const char *outfile)
>  
>  		fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
>  			"$common_secs, $common_nsecs,\n\t             "
> -			"$common_pid, $common_comm);\n\n");
> +			"$common_pid, $common_comm, $common_callchain);\n\n");
>  
>  		fprintf(ofp, "\tprintf(\"");
>  
> @@ -577,17 +670,22 @@ static int perl_generate_script(struct pevent *pevent, const char *outfile)
>  				fprintf(ofp, "$%s", f->name);
>  		}
>  
> -		fprintf(ofp, ");\n");
> +		fprintf(ofp, ");\n\n");
> +
> +		fprintf(ofp, "\tprint_backtrace($common_callchain);\n");
> +
>  		fprintf(ofp, "}\n\n");
>  	}
>  
>  	fprintf(ofp, "sub trace_unhandled\n{\n\tmy ($event_name, $context, "
>  		"$common_cpu, $common_secs, $common_nsecs,\n\t    "
> -		"$common_pid, $common_comm) = @_;\n\n");
> +		"$common_pid, $common_comm, $common_callchain) = @_;\n\n");
>  
>  	fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
>  		"$common_secs, $common_nsecs,\n\t             $common_pid, "
> -		"$common_comm);\n}\n\n");
> +		"$common_comm, $common_callchain);\n");
> +	fprintf(ofp, "\tprint_backtrace($common_callchain);\n");
> +	fprintf(ofp, "}\n\n");
>  
>  	fprintf(ofp, "sub print_header\n{\n"
>  		"\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n"
> -- 
> 2.1.4
> 

Powered by blists - more mailing lists

Powered by Openwall GNU/*/Linux Powered by OpenVZ