libvirt/src/dtrace2systemtap.pl
Eric Blake 4ecb723b9e maint: fix up copyright notice inconsistencies
https://www.gnu.org/licenses/gpl-howto.html recommends that
the 'If not, see <url>.' phrase be a separate sentence.

* tests/securityselinuxhelper.c: Remove doubled line.
* tests/securityselinuxtest.c: Likewise.
* globally: s/;  If/.  If/
2012-09-20 16:30:55 -06:00

132 lines
3.7 KiB
Perl
Executable File

#!/usr/bin/perl
#
# Copyright (C) 2011-2012 Red Hat, Inc.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library. If not, see
# <http://www.gnu.org/licenses/>.
#
# Author: Daniel P. Berrange <berrange@redhat.com>
#
# Generate a set of systemtap probe definitions corresponding to
# DTrace probe markers in libvirt.so
#
# perl dtrace2systemtap.pl probes.d > libvirt_probes.stp
#
use strict;
use warnings;
my $file;
my @files;
my %files;
my $with_modules = 0;
if ($ARGV[0] eq "--with-modules") {
# set if we want to honor the "module" setting in the .d file
$with_modules = 1;
shift @ARGV;
}
my $bindir = shift @ARGV;
my $sbindir = shift @ARGV;
my $libdir = shift @ARGV;
my $probe;
my $args;
# Read the DTraceprobes definition
while (<>) {
next if m,^\s*$,;
next if /^\s*provider\s+\w+\s*{\s*$/;
next if /^\s*};\s*$/;
if (m,^\s*\#,) {
if (m,^\s*\#\s*file:\s*(\S+)\s*$,) {
$file = $1;
push @files, $file;
$files{$file} = { prefix => undef, probes => [] };
} elsif (m,^\s*\#\s*prefix:\s*(\S+)\s*$,) {
$files{$file}->{prefix} = $1;
} elsif (m,^\s*\#\s*binary:\s*(\S+)\s*$,) {
$files{$file}->{binary} = $1;
} elsif (m,^\s*\#\s*module:\s*(\S+)\s*$,) {
$files{$file}->{module} = $1;
} else {
# ignore unknown comments
}
} else {
if (m,\s*probe\s+([a-zA-Z0-9_]+)\((.*?)(\);)?$,) {
$probe = $1;
$args = $2;
if ($3) {
push @{$files{$file}->{probes}}, [$probe, $args];
$probe = $args = undef;
}
} elsif ($probe) {
if (m,^(.*?)(\);)?$,) {
$args .= $1;
if ($2) {
push @{$files{$file}->{probes}}, [$probe, $args];
$probe = $args = undef;
}
} else {
die "unexpected data $_ on line $.";
}
} else {
die "unexpected data $_ on line $.";
}
}
}
# Write out the SystemTap probes
foreach my $file (@files) {
my $prefix = $files{$file}->{prefix};
my @probes = @{$files{$file}->{probes}};
print "# $file\n\n";
foreach my $probe (@probes) {
my $name = $probe->[0];
my $args = $probe->[1];
my $pname = $name;
$pname =~ s/${prefix}_/libvirt.$prefix./;
my $binary = "$libdir/libvirt.so";
if (exists $files{$file}->{binary}) {
$binary = $sbindir . "/" . $files{$file}->{binary};
}
if ($with_modules && exists $files{$file}->{module}) {
$binary = $libdir . "/" . $files{$file}->{module};
}
print "probe $pname = process(\"$binary\").mark(\"$name\") {\n";
my @args = split /,/, $args;
for (my $i = 0 ; $i <= $#args ; $i++) {
my $arg = $args[$i];
my $isstr = $arg =~ /char\s+\*/;
$arg =~ s/^.*\s\*?(\S+)$/$1/;
if ($isstr) {
print " $arg = user_string(\$arg", $i + 1, ");\n";
} else {
print " $arg = \$arg", $i + 1, ";\n";
}
}
print "}\n\n";
}
print "\n";
}