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 = 20200301;
$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 $start = now() - 0.0001;
    my $avg = 1;
    my $seeks = 1;
    while(1) {
	my $s = $size*rand();
	seek($fh,$s,SEEK_SET) || ::die_bug("cannot seek $dev");
	read($fh,$buf,1);
	$seeks++;
	# Exponential moving average
	$avg = 0.9 * $avg + 0.1 * $seeks/(now()-$start);
	print $spin[($seeks/$avg*4)%@spin]," ",int($avg)," seeks per seconds   \r";
    }
} else {
    ::error("cannot open $dev");
    wait_and_exit(255);
}