tangetools/seekmaniac/seekmaniac
2023-11-07 01:33:57 +01:00

187 lines
4.2 KiB
Perl
Executable file

#!/usr/bin/perl -w
=pod
=head1 NAME
seekmaniac - Do random seeks on a file or a device
=head1 SYNOPSIS
B<seekmaniac> I<file>
=head1 DESCRIPTION
B<seekmaniac> is used to stress your magnetic hard drive by seeking to
random positions and reading a byte.
=head1 EXAMPLE
Stress /dev/sda
seekmaniac /dev/sda
=head1 AUTHOR
Copyright (C) 2020 Ole Tange,
http://ole.tange.dk and Free Software Foundation, Inc.
=head1 LICENSE
Copyright (C) 2012 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
at your option any later version.
This program 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 General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
=head1 DEPENDENCIES
B<seekmaniac> uses B<perl>.
=head1 SEE ALSO
B<perl>
=cut
use strict;
use Fcntl qw(SEEK_END SEEK_SET);
sub size_of_block_dev($) {
# Like -s but for block devices
# Input:
# $blockdev = file name of block device
# Returns:
# $size = in bytes, undef if error
my $blockdev = shift;
if(open(my $fh, "<", $blockdev)) {
seek($fh,0,SEEK_END) || ::die_bug("cannot seek $blockdev");
my $size = tell($fh);
close $fh;
return $size;
} else {
::error("cannot open $blockdev");
exit(255);
}
}
sub status(@) {
my @w = @_;
my $fh = $Global::status_fd || *STDERR;
print $fh map { ($_, "\n") } @w;
flush $fh;
}
sub status_no_nl(@) {
my @w = @_;
my $fh = $Global::status_fd || *STDERR;
print $fh @w;
flush $fh;
}
sub warning(@) {
my @w = @_;
my $prog = $Global::progname || "parallel";
status_no_nl(map { ($prog, ": Warning: ", $_, "\n"); } @w);
}
sub error(@) {
my @w = @_;
my $prog = $Global::progname || "parallel";
status(map { ($prog.": Error: ". $_); } @w);
}
sub die_bug($) {
my $bugid = shift;
print STDERR
("$Global::progname: This should not happen. You have found a bug.\n",
"Please file a bugreport https://gitlab.com/ole.tange/tangetools/issues\n",
"\n",
"Include this in the report:\n",
"* The version number: $Global::version\n",
"* The bugid: $bugid\n",
"* The command line being run\n",
"* The files being read (put the files on a webserver if they are big)\n",
"\n",
"If you get the error on smaller/fewer files, please include those instead.\n");
exit(255);
}
sub now() {
# Returns time since epoch as in seconds with 3 decimals
# Uses:
# @Global::use
# Returns:
# $time = time now with millisecond accuracy
if(not $Global::use{"Time::HiRes"}) {
if(eval "use Time::HiRes qw ( time );") {
eval "sub TimeHiRestime { return Time::HiRes::time };";
} else {
eval "sub TimeHiRestime { return time() };";
}
$Global::use{"Time::HiRes"} = 1;
}
return (int(TimeHiRestime()*1000))/1000;
}
$Global::version = 20231020;
$Global::progname = "seekmaniac";
my $dev = shift;
my $size = size_of_block_dev($dev);
my ($buf,$t);
if(open(my $fh, "<", $dev)) {
$| = 1;
my @spin = split//,q[/-\|/-\|/-\|/-\|].
q[>)|(<-<(|)>->)|(<-<(|)>->)|(<-<(|].
q[!:.oOo.oOo.oOo.oOo.,;'"';,:=-];
my $avg = 1;
my $seeks = 1;
my $last_seeks = 0;
my $now = now();
my $last = $now;
my $next_print = $now;
my $spin = 0;
my $warmup = 0;
while(1) {
my $s = $size * rand();
seek($fh,$s,SEEK_SET) || ::die_bug("cannot seek $dev");
read($fh,$buf,1);
$seeks++;
$now = now();
if($now - $next_print > 0.25) {
$spin++;
if($now - $last > 0) {
# Exponential moving average
$warmup = $warmup * 0.95 + 0.05 * 0.9;
$avg = $warmup * $avg +
(1-$warmup) * ($seeks - $last_seeks) / ($now - $last);
$last_seeks = $seeks;
$last = $now;
}
print $spin[$spin % @spin]," ",
int($avg)," seeks per second \r";
# Print next time in 0.25 sec
$next_print += 0.25;
}
}
} else {
::error("cannot open $dev");
wait_and_exit(255);
}