| 
									
										
										
										
											2010-04-01 23:59:23 -05:00
										 |  |  | #!/usr/bin/perl -w | 
					
						
							|  |  |  | # (c) 2010, Tom Zanussi <tzanussi@gmail.com> | 
					
						
							|  |  |  | # Licensed under the terms of the GNU GPL License version 2 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # read/write top | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Periodically displays system-wide r/w call activity, broken down by | 
					
						
							|  |  |  | # pid.  If an [interval] arg is specified, the display will be | 
					
						
							|  |  |  | # refreshed every [interval] seconds.  The default interval is 3 | 
					
						
							|  |  |  | # seconds. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | use 5.010000; | 
					
						
							|  |  |  | use strict; | 
					
						
							|  |  |  | use warnings; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib"; | 
					
						
							|  |  |  | use lib "./Perf-Trace-Util/lib"; | 
					
						
							|  |  |  | use Perf::Trace::Core; | 
					
						
							|  |  |  | use Perf::Trace::Util; | 
					
						
							| 
									
										
										
										
											2013-02-05 17:05:50 +01:00
										 |  |  | use POSIX qw/SIGALRM SA_RESTART/; | 
					
						
							| 
									
										
										
										
											2010-04-01 23:59:23 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | my $default_interval = 3; | 
					
						
							|  |  |  | my $nlines = 20; | 
					
						
							|  |  |  | my $print_thread; | 
					
						
							| 
									
										
										
										
											2010-05-09 23:46:54 -05:00
										 |  |  | my $print_pending = 0; | 
					
						
							| 
									
										
										
										
											2010-04-01 23:59:23 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | my %reads; | 
					
						
							|  |  |  | my %writes; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | my $interval = shift; | 
					
						
							|  |  |  | if (!$interval) { | 
					
						
							|  |  |  |     $interval = $default_interval; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | sub syscalls::sys_exit_read | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  |     my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | 
					
						
							|  |  |  | 	$common_pid, $common_comm, | 
					
						
							|  |  |  | 	$nr, $ret) = @_; | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-05-09 23:46:54 -05:00
										 |  |  |     print_check(); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-04-01 23:59:23 -05:00
										 |  |  |     if ($ret > 0) { | 
					
						
							|  |  |  | 	$reads{$common_pid}{bytes_read} += $ret; | 
					
						
							|  |  |  |     } else { | 
					
						
							|  |  |  | 	if (!defined ($reads{$common_pid}{bytes_read})) { | 
					
						
							|  |  |  | 	    $reads{$common_pid}{bytes_read} = 0; | 
					
						
							|  |  |  | 	} | 
					
						
							|  |  |  | 	$reads{$common_pid}{errors}{$ret}++; | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | sub syscalls::sys_enter_read | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  |     my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | 
					
						
							|  |  |  | 	$common_pid, $common_comm, | 
					
						
							|  |  |  | 	$nr, $fd, $buf, $count) = @_; | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-05-09 23:46:54 -05:00
										 |  |  |     print_check(); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-04-01 23:59:23 -05:00
										 |  |  |     $reads{$common_pid}{bytes_requested} += $count; | 
					
						
							|  |  |  |     $reads{$common_pid}{total_reads}++; | 
					
						
							|  |  |  |     $reads{$common_pid}{comm} = $common_comm; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | sub syscalls::sys_exit_write | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  |     my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | 
					
						
							|  |  |  | 	$common_pid, $common_comm, | 
					
						
							|  |  |  | 	$nr, $ret) = @_; | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-05-09 23:46:54 -05:00
										 |  |  |     print_check(); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-04-01 23:59:23 -05:00
										 |  |  |     if ($ret <= 0) { | 
					
						
							|  |  |  | 	$writes{$common_pid}{errors}{$ret}++; | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | sub syscalls::sys_enter_write | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  |     my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | 
					
						
							|  |  |  | 	$common_pid, $common_comm, | 
					
						
							|  |  |  | 	$nr, $fd, $buf, $count) = @_; | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-05-09 23:46:54 -05:00
										 |  |  |     print_check(); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-04-01 23:59:23 -05:00
										 |  |  |     $writes{$common_pid}{bytes_written} += $count; | 
					
						
							|  |  |  |     $writes{$common_pid}{total_writes}++; | 
					
						
							|  |  |  |     $writes{$common_pid}{comm} = $common_comm; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | sub trace_begin | 
					
						
							|  |  |  | { | 
					
						
							| 
									
										
										
										
											2013-02-05 17:05:50 +01:00
										 |  |  |     my $sa = POSIX::SigAction->new(\&set_print_pending); | 
					
						
							|  |  |  |     $sa->flags(SA_RESTART); | 
					
						
							|  |  |  |     $sa->safe(1); | 
					
						
							|  |  |  |     POSIX::sigaction(SIGALRM, $sa) or die "Can't set SIGALRM handler: $!\n"; | 
					
						
							| 
									
										
										
										
											2010-04-01 23:59:23 -05:00
										 |  |  |     alarm 1; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | sub trace_end | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  |     print_unhandled(); | 
					
						
							|  |  |  |     print_totals(); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-05-09 23:46:54 -05:00
										 |  |  | sub print_check() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  |     if ($print_pending == 1) { | 
					
						
							|  |  |  | 	$print_pending = 0; | 
					
						
							|  |  |  | 	print_totals(); | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | sub set_print_pending() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  |     $print_pending = 1; | 
					
						
							|  |  |  |     alarm $interval; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-04-01 23:59:23 -05:00
										 |  |  | sub print_totals | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  |     my $count; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     $count = 0; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     clear_term(); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     printf("\nread counts by pid:\n\n"); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     printf("%6s  %20s  %10s  %10s  %10s\n", "pid", "comm", | 
					
						
							|  |  |  | 	   "# reads", "bytes_req", "bytes_read"); | 
					
						
							|  |  |  |     printf("%6s  %-20s  %10s  %10s  %10s\n", "------", "--------------------", | 
					
						
							|  |  |  | 	   "----------", "----------", "----------"); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-05-09 23:46:54 -05:00
										 |  |  |     foreach my $pid (sort { ($reads{$b}{bytes_read} || 0) <=> | 
					
						
							|  |  |  | 			       ($reads{$a}{bytes_read} || 0) } keys %reads) { | 
					
						
							|  |  |  | 	my $comm = $reads{$pid}{comm} || ""; | 
					
						
							|  |  |  | 	my $total_reads = $reads{$pid}{total_reads} || 0; | 
					
						
							|  |  |  | 	my $bytes_requested = $reads{$pid}{bytes_requested} || 0; | 
					
						
							|  |  |  | 	my $bytes_read = $reads{$pid}{bytes_read} || 0; | 
					
						
							| 
									
										
										
										
											2010-04-01 23:59:23 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | 	printf("%6s  %-20s  %10s  %10s  %10s\n", $pid, $comm, | 
					
						
							|  |  |  | 	       $total_reads, $bytes_requested, $bytes_read); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 	if (++$count == $nlines) { | 
					
						
							|  |  |  | 	    last; | 
					
						
							|  |  |  | 	} | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     $count = 0; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     printf("\nwrite counts by pid:\n\n"); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     printf("%6s  %20s  %10s  %13s\n", "pid", "comm", | 
					
						
							|  |  |  | 	   "# writes", "bytes_written"); | 
					
						
							|  |  |  |     printf("%6s  %-20s  %10s  %13s\n", "------", "--------------------", | 
					
						
							|  |  |  | 	   "----------", "-------------"); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-05-09 23:46:54 -05:00
										 |  |  |     foreach my $pid (sort { ($writes{$b}{bytes_written} || 0) <=> | 
					
						
							|  |  |  | 			($writes{$a}{bytes_written} || 0)} keys %writes) { | 
					
						
							|  |  |  | 	my $comm = $writes{$pid}{comm} || ""; | 
					
						
							|  |  |  | 	my $total_writes = $writes{$pid}{total_writes} || 0; | 
					
						
							|  |  |  | 	my $bytes_written = $writes{$pid}{bytes_written} || 0; | 
					
						
							| 
									
										
										
										
											2010-04-01 23:59:23 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | 	printf("%6s  %-20s  %10s  %13s\n", $pid, $comm, | 
					
						
							|  |  |  | 	       $total_writes, $bytes_written); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 	if (++$count == $nlines) { | 
					
						
							|  |  |  | 	    last; | 
					
						
							|  |  |  | 	} | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     %reads = (); | 
					
						
							|  |  |  |     %writes = (); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | my %unhandled; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | sub print_unhandled | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  |     if ((scalar keys %unhandled) == 0) { | 
					
						
							|  |  |  | 	return; | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     print "\nunhandled events:\n\n"; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     printf("%-40s  %10s\n", "event", "count"); | 
					
						
							|  |  |  |     printf("%-40s  %10s\n", "----------------------------------------", | 
					
						
							|  |  |  | 	   "-----------"); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     foreach my $event_name (keys %unhandled) { | 
					
						
							|  |  |  | 	printf("%-40s  %10d\n", $event_name, $unhandled{$event_name}); | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | sub trace_unhandled | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  |     my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | 
					
						
							|  |  |  | 	$common_pid, $common_comm) = @_; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     $unhandled{$event_name}++; | 
					
						
							|  |  |  | } |