tangetools/seekmaniac/seekmaniac

#!/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);
}