seekmaniac: Initial version.
This commit is contained in:
Ole Tange
parent
7b6539f84b
commit
93436e3511
19
Makefile
19
Makefile
|
|
@ -1,8 +1,8 @@
|
|||
CMD = blink bsearch burncpu duplicate-packets em encdir field forever \
|
||||
fxkill G gitnext gitundo goodpasswd histogram mtrr mirrorpdf \
|
||||
neno off pdfman pidcmd plotpipe puniq ramusage rand rclean \
|
||||
rina rn rrm shython sound-reload splitvideo stdout swapout T \
|
||||
timestamp tracefile transpose upsidedown vid \
|
||||
rina rn rrm seekmaniac shython sound-reload splitvideo stdout \
|
||||
swapout T timestamp tracefile transpose upsidedown vid \
|
||||
w4it-for-port-open whitehash wifi-reload wssh ytv yyyymmdd
|
||||
|
||||
all: blink/blink.1 bsearch/bsearch.1 burncpu/burncpu.1 \
|
||||
|
|
@ -10,12 +10,12 @@ all: blink/blink.1 bsearch/bsearch.1 burncpu/burncpu.1 \
|
|||
goodpasswd/goodpasswd.1 histogram/histogram.1 \
|
||||
mirrorpdf/mirrorpdf.1 neno/neno.1 off/off.1 pdfman/pdfman.1 \
|
||||
pidcmd/pidcmd.1 plotpipe/plotpipe.1 puniq/puniq.1 rand/rand.1 \
|
||||
rina/rina.1 rn/rn.1 rrm/rrm.1 shython/shython.1 \
|
||||
sound-reload/sound-reload.1 splitvideo/splitvideo.1 \
|
||||
stdout/stdout.1 timestamp/timestamp.1 tracefile/tracefile.1 \
|
||||
transpose/transpose.1 T/T.1 upsidedown/upsidedown.1 vid/vid.1 \
|
||||
wifi-reload/wifi-reload.1 wssh/wssh.1 ytv/ytv.1 \
|
||||
yyyymmdd/yyyymmdd.1
|
||||
rina/rina.1 rn/rn.1 rrm/rrm.1 seekmaniac/seekmaniac.1 \
|
||||
shython/shython.1 sound-reload/sound-reload.1 \
|
||||
splitvideo/splitvideo.1 stdout/stdout.1 timestamp/timestamp.1 \
|
||||
tracefile/tracefile.1 transpose/transpose.1 T/T.1 \
|
||||
upsidedown/upsidedown.1 vid/vid.1 wifi-reload/wifi-reload.1 \
|
||||
wssh/wssh.1 ytv/ytv.1 yyyymmdd/yyyymmdd.1
|
||||
|
||||
%.1: %
|
||||
pod2man $< > $@
|
||||
|
|
@ -26,5 +26,4 @@ install:
|
|||
mkdir -p /usr/local/share/man/man1
|
||||
parallel ln -sf `pwd`/{} /usr/local/share/man/man1/{/} ::: */*.1
|
||||
mkdir -p $(HOME)/.local/share/vlc/lua/extensions
|
||||
ln -sf `pwd`/splitvideo/dotlocal/share/vlc/lua/extensions/splitvideo.lua $(HOME)/.local/share/vlc/lua/extensions/splitvideo.lua
|
||||
ln -sf `pwd`/wastebasket/dotlocal/share/vlc/lua/extensions/WasteBasket.lua $(HOME)/.local/share/vlc/lua/extensions/WasteBasket.lua
|
||||
parallel ln -sf `pwd`/{} $(HOME)/.local/{=s:[^/]+/[^/]+/::=} ::: */dotlocal/*/*/*/*/*.lua
|
||||
|
|
|
|||
142
seekmaniac/seekmaniac
Executable file
142
seekmaniac/seekmaniac
Executable file
|
|
@ -0,0 +1,142 @@
|
|||
#!/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);
|
||||
}
|
||||
|
||||
$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 = qw(/ - \ |);
|
||||
while(1) {
|
||||
my $s = $size*rand();
|
||||
seek($fh,$s,SEEK_SET) || ::die_bug("cannot seek $dev");
|
||||
read($fh,$buf,1);
|
||||
print $spin[($t++/10)%@spin],"\r";
|
||||
}
|
||||
} else {
|
||||
::error("cannot open $dev");
|
||||
wait_and_exit(255);
|
||||
}
|
||||
|
|
@ -19,6 +19,10 @@ do{
|
|||
qx{ awk '/^((Swap)?Cached|MemFree|Buffers):/ { sum += \$2} END { print sum }' /proc/meminfo }
|
||||
/ 1024);
|
||||
print "Free $free ";
|
||||
if($free <= 1) {
|
||||
print "\nFree < 1\n";
|
||||
exit(1);
|
||||
}
|
||||
$total += int($free/100);
|
||||
$missing = $total - $sofar;
|
||||
for(1..$missing) {
|
||||
|
|
|
|||
9
ytv/ytv
9
ytv/ytv
|
|
@ -110,14 +110,17 @@ sub playfiles {
|
|||
::die_bug("interactive-tty");
|
||||
$answer = <$tty_fh>;
|
||||
close $tty_fh;
|
||||
if($answer =~ /d/i) {
|
||||
if($answer =~ /^d$/i) {
|
||||
unlink $_;
|
||||
}
|
||||
if($answer =~ /p/i) {
|
||||
if($answer =~ /^p$/i) {
|
||||
$i -= 2;
|
||||
}
|
||||
}
|
||||
} while($answer =~ /^$|r/i);
|
||||
} while($answer =~ /^r?$/i);
|
||||
}
|
||||
if($answer =~ m,http.?://,) {
|
||||
play($answer);
|
||||
}
|
||||
} else {
|
||||
system("vlc", map { $a=$b=$_; $b=~s/.part//; s/.temp//; $a,$b,$_ } @files);
|
||||
|
|
|
|||
Loading…
Reference in a new issue