#!/usr/bin/perl use strict; use warnings; # Copyright (C) 2012 Glen Pitt-Pladdy # # 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 2 # 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, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. # # # See: http://www.pitt-pladdy.com/blog/_20120215-111422_0000_Filesystems_Fragmentation/ print "This script could do dammage to your system. To discourage it's use\n"; print "without sufficient knowledge of the risks or safety precautions\n"; print "in place, the script has to be modified before it will run\n"; exit; my $FILEFRAG = '/usr/sbin/filefrag'; my $CP = '/bin/cp'; use Cwd; use Time::HiRes qw( usleep ); # args - user, group, files.... my $badargs = 0; if ( $#ARGV < 2 ) { ++$badargs; } my %flags; my %settings; while ( $ARGV[0] =~ /^--(\w[\w\-]+)$/ or $ARGV[0] =~ /^--(\w[\w\-]+)=(\d+)$/ ) { if ( $1 eq 'dorecent' or $1 eq 'verbose' or $1 eq 'readstdin' ) { $flags{$1} = 1; } elsif ( ( $1 eq 'usleep' or $1 eq 'skiplowfrag' or $1 eq 'skipbig' ) and defined $2 ) { $settings{$1} = $2; } else { warn "Invalid option \"$ARGV[0]\" specified\n"; $badargs = 1; last; } shift @ARGV; } my $uid = getpwnam ( shift @ARGV ); my $gid = getgrnam ( shift @ARGV ); if ( ! defined $uid or ! defined $gid ) { warn "Invalid user / group specified\n"; ++$badargs; } if ( $badargs ) { die "Usage: $0 [--dorecent] [--readstdin] [--verbose] [--skiplowfrag=#KB/frag] [--skipbig=#KB] [--usleep=NNNN] [....files]\n"; } # switch to the correct eudi egid $) = $gid; $> = $uid; if ( $> != $uid or $) != $gid ) { die "FATAL - can't switch euid / egid\n"; } # process each file my $count = 0; my $improved = 0; my $skipped = 0; my @files; if ( $flags{'readstdin'} ) { @files = ; chomp @files; } else { @files = @ARGV; } foreach my $file (@files) { if ( defined $settings{'usleep'} ) { usleep $settings{'usleep'}; } if ( -d $file ) { next; } if ( ! -f $file ) { warn "WARNING - can't find file to process: $file\n"; next; } if ( -l $file ) { warn "WARNING - refusing to process symlink: $file\n"; next; } if ( $file =~ /^(.+)\.gz$/ and -f $1 ) { warn "WARNING - refusing to process .gz while original exists: $file\n"; next; } if ( ! defined $flags{'dorecent'} and -M $file < 0.04167 ) { warn "WARNING - refusing to process recent file: $file\n"; next; } if ( ( stat $file )[3] > 1 ) { warn "WARNING - refusing to process file with hard links: $file\n"; next; } if ( checkopen($file) ) { warn "WARNING - refusing to process currently open file: $file\n"; next; } ++$count; my $result = defrag ( $file ); if ( defined $result ) { if ( $result < 0 ) { ++$skipped; } else { ++$improved; } } } print "Improved $improved of ".($count-$skipped).", skippking $skipped of $count\n"; sub checkopen { my $file = shift; if ( $file !~ /^\// ) { $file = cwd().'/'.$file; } my $uidtmp = $>; my $gidtmp = $); $) = 0; $> = 0; if ( $> != 0 or $) != 0 ) { die "FATAL - can't switch to root euid / egid\n"; } my $open = 0; foreach my $link (glob "/proc/*/fd/*") { if ( ! -l $link ) { next; } my $dest = readlink ( $link ); if ( defined $dest and $dest eq $file ) { $open = 1; last; } } $) = $gidtmp; $> = $uidtmp; return $open; } sub getfrag { my $file = shift; my $uidtmp = $>; my $gidtmp = $); $) = 0; $> = 0; if ( $> != 0 or $) != 0 ) { die "FATAL - can't switch to root euid / egid\n"; } $file =~ s/\\/\\\\/g; $file =~ s/"/\\"/g; $file =~ s/\$/\\\$/g; open my $pipe, '-|', "$FILEFRAG \"$file\"" or die "FATAL - can't run \"$FILEFRAG \"$file\"\": $!\n"; my $return = <$pipe>; close $pipe; if ( $return !~ s/^.+: (\d+) extents? found$/$1/ ) { die "FATAL - don't understand output from \"$FILEFRAG \"$file\"\": $return\n"; } if ( $return > 0 ) { --$return; } $) = $gidtmp; $> = $uidtmp; return $return; } sub defrag { my $file = shift; my $prefrag = getfrag ( $file ); if ( $prefrag == 0 ) { return -1; } if ( defined $settings{'skipbig'} and -s $file > $settings{'skipbig'} ) { return -1; } my $fragkb = ( -s $file ) / $prefrag / 1024; if ( defined $settings{'skiplowfrag'} and $fragkb > $settings{'skiplowfrag'} ) { return -1; } # worth having a go at defragging my $tmp = $file; if ( $tmp !~ s/\/([^\/]+)$/\/TMP_$$\_$1/ and $tmp !~ s/^([^\/]+)$/TMP_$$\_$1/ ) { die "FATAL - can't generate TMP file for: $file\n"; } if ( -f $tmp ) { die "FATAL - TMP file \"$tmp\" already exists!\n"; } system ( $CP, '-an', $file, $tmp ) == 0 or die "FATAL - can't run \"$CP\" on \"$file\" to \"$tmp\": $?\n"; my $postfrag = getfrag ( $tmp ); my @poststat = stat $tmp; my @prestat = stat $file; if ( $postfrag < $prefrag and $poststat[0] == $prestat[0] # dev and $poststat[2] == $prestat[2] # mode and $poststat[3] == $prestat[3] # nlink and $poststat[4] == $prestat[4] # uid and $poststat[5] == $prestat[5] # gid and $poststat[7] == $prestat[7] # size # and $poststat[8] == $prestat[8] # atime and $poststat[9] == $prestat[9] # mtime and ! checkopen ( $file ) ) { if ( defined $flags{'verbose'} ) { print "$file: good defrag ($prefrag=>$postfrag)\n"; } rename $tmp, $file or die "FATAL - can't move TMP \"$tmp\" to original \"$file\": $!\n"; } else { if ( defined $flags{'verbose'} ) { print "$file: bad defrag ($prefrag=>$postfrag)\n"; if ( $postfrag >= $prefrag ) { # nothing to do } elsif ( checkopen ( $file ) ) { print "\tfile open\n"; } elsif ( $poststat[4] != $prestat[4] or $poststat[5] != $prestat[5] ) { print "\tUID/GID different:\n\t\t".join(',',@prestat)."\n\t\t".join(',',@poststat)."\n"; } else { print "\tmismatch between files:\n\t\t".join(',',@prestat)."\n\t\t".join(',',@poststat)."\n"; } } unlink $tmp or die "FATAL - can't unlink TMP \"$tmp\": $!\n"; return undef; } return $postfrag; }