| 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
| ||
|
Message-ID: <20160328210327.GG8706@kernel.org>
Date: Mon, 28 Mar 2016 18:03:27 -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 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.
- Arnaldo
> ---
> .../perf/util/scripting-engines/trace-event-perl.c | 115 +++++++++++++++++++--
> 1 file changed, 107 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..f048c58 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,79 @@ 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;
> +
> + // mortal?
> + 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 +362,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 +397,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 +435,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 +559,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 +591,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 +609,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 +671,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"
Powered by blists - more mailing lists