s390-tools/cpumf/bin/chcpumf.in

#!/usr/bin/perl -W
#
# chcpumf - Control CPU-measurement facilities
#
# Copyright IBM Corp. 2014, 2017
#
# s390-tools is free software; you can redistribute it and/or modify
# it under the terms of the MIT license. See LICENSE for details.
#
use strict;
use warnings;
use File::Basename qw/fileparse/;
use Data::Dumper;
use Getopt::Long qw/:config no_ignore_case/;

# Global constants
my $CPUMF_HELPER = '@lib_path@/cpumf_helper';
my $CPUM_SFB_SIZE = '/sys/module/kernel/parameters/cpum_sfb_size';

# Prototypes
sub main();
sub show_help();
sub show_version();
sub do_set_sfb_size($);
sub cpumf_set_sfb_size($);
sub invoke_cpumf_helper($);

sub main()
{
	my $config = {
		# Internal data
		cpumf	    => {},	# CPU-MF information hash
	};

	unless (GetOptions(
		# General options for help, version, verbose,...
		"h|help"	      => \&show_help,
		"v|version"	      => \&show_version,
		"V|verbose+"	      => \$config->{verbose},
		# Change specific options
		"m|min=i"	    => \$config->{min},
		"x|max=i"	    => \$config->{max},
	)) {
		print STDERR "One or more options are not valid\n";
		print STDERR "Try '" . fileparse($0) .
			      " --help' for more information\n";
		exit 1;
	}

	# Collect CPU-MF information
	$config->{cpumf} = invoke_cpumf_helper("-i");
	die "Failed to collect CPU-MF information: $!\n" unless $config->{cpumf};

	# Process parameters
	my $exitval = 5;
	if (defined($config->{min}) || defined($config->{max})) {
		$exitval = do_set_sfb_size($config);
	} else {
		print STDERR "You must specify a valid option\n";
		exit 1;
	}

	exit($exitval);
}

sub show_help()
{
	my $prog = fileparse($0);

	print <<"EoHelp";
Usage:	chcpumf -h|-v
	chcpumf -m <num_sdb>
	chcpumf -x <num_sdb>

Options:
	-m <num_sdb>  Specifies the initial size of the sampling buffer.
		      A sample-data-block (SDB) consumes about 4 kilobytes.
	-x <num_sdb>  Specifies the maximum size of the sampling buffer.
		      A sample-data-block (SDB) consumes about 4 kilobytes.
	-h	      Displays help information, then exits.
	-v	      Displays version information, then exits.

For more help information, issue 'man $prog'.
EoHelp
	exit 0;
}

sub show_version()
{
	print <<'EoVersion';
CPU-measurement facility utilities, version @S390_TOOLS_RELEASE@
Copyright IBM Corp. 2014, 2017

EoVersion
	exit 0;
}

sub cpumf_set_sfb_size($)
{
	my @size = @{shift()};
	my $val = join ',', @size[0,1];
	my ($SFBSIZE, $rc);

	return undef unless open($SFBSIZE, '>', $CPUM_SFB_SIZE);
	# Check the return code of print and close to detect error conditions
	# reported by the device driver.  Because perl might buffer data, print
	# might be successful, but close might then report the error condition.
	# So check the return code of both functions and always close the file
	# handle.
	$rc = print { $SFBSIZE } "$val\n";
	unless ($rc) {
		close($SFBSIZE);
		return $rc;
	}
	return close($SFBSIZE);
}

sub do_set_sfb_size($)
{
	my $c = shift();
	my $size;

	# Check if sampling facility is available
	unless (exists $c->{cpumf}->{sf}) {
		print STDERR "No CPU-measurement sampling facility detected\n";
		return 2;
	}
	# Check if perf support is available
	unless (exists $c->{cpumf}->{sf}->{perf}) {
		print STDERR "No perf support for the CPU-measurement" .
			     " sampling facility availalble\n";
		return 2;
	}

	# Optionally, change the sampling buffer sizes
	if (defined($c->{min}) || defined($c->{max})) {
		$size = invoke_cpumf_helper("--sfb-size");
		# Use current size value for zero min/max specifications
		$size->[0] = $c->{min} if defined($c->{min});
		$size->[1] = $c->{max} if defined($c->{max});
		# Validate new settings
		if ($size->[0] < 1 || $size->[1] < 1) {
			die "The specified number(s) are not valid\n";
		}
		if ($size->[0] >= $size->[1]) {
			die "The specified maximum must be greater " .
			    "than the minimum\n";
		}
		# Set new sampling buffer sizes
		unless (cpumf_set_sfb_size($size)) {
			die "Failed to change sampling buffer size: $!\n";
		}
	}

	# Finally, show sampling buffer sizes
	if ($c->{verbose}) {
		$size = invoke_cpumf_helper("--sfb-size");
		print "Sampling buffer sizes:\n";
		printf "    Minimum: %6u sample-data-blocks\n", $size->[0];
		printf "    Maximum: %6u sample-data-blocks\n", $size->[1];
	}

	return 0;
}

sub invoke_cpumf_helper($)
{
	my $parms = shift();
	my $result;

	# Call helper module
	my $output = qx"$CPUMF_HELPER $parms";
	die "Failed to run helper module for '$parms'\n" if $? >> 8;
	$result = eval "$output";
	die "Failed to parse helper module data\n" if $@;

	return $result;
}

&main();
__DATA__
__END__