#!/usr/bin/perl -w
#
# wipe - Deletes files "securely".
#
# Copyright (C) 1999 Steven Pritchard <steve@silug.org>
# This program is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# 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.
#
# $Id: wipe,v 1.3 2000/03/14 16:13:34 steve Exp $

use strict;

use FileHandle;
use DirHandle;

use vars qw($recursive $debug);

$debug=1;

if (@ARGV && $ARGV[0] eq "-r")
{
    shift;
    $recursive++;
}

if ($#ARGV==-1)
{
    print STDERR "Usage: @{[
            substr($0, rindex($0, '/')+1)
        ]} [-r] file [file [...]]\n";
    exit 0;
}

my $n;

for ($n=0;$n<=$#ARGV;$n++)
{
    if (lstat($ARGV[$n]))
    {
        if (-f(_))
        {
	    if (-s(_))
	    {
                &wipe($ARGV[$n]);
	    }
	    else
	    {
		unlink($ARGV[$n]) or warn "Couldn't unlink $ARGV[$n]: $!\n";
	    }
        }
        elsif ($recursive && -d(_))
        {
            &recurse_into($ARGV[$n]);
        }
	elsif (-l(_) || -p(_) || -S(_) || -b(_) || -c(_))
	{
	    unlink($ARGV[$n]) or warn "Couldn't unlink $ARGV[$n]: $!\n";
	}
	else
	{
	    die "Don't know how to handle $ARGV[$n]!\n";
	}
    }
    else
    {
        print STDERR "$ARGV[$n] not found";
        print STDERR " or not a regular file" if (!$recursive);
        print STDERR ", skipping...\n";
    }
}

sub recurse_into
{
    my($dir)=@_;
    my($dh, $file);

    $dh=new DirHandle $dir;

    foreach $file (grep(!/^\.\.?$/, $dh->read()))
    {
	if (lstat("$dir/$file"))
	{
            if (-f(_))
            {
		if (-s(_))
		{
                    &wipe("$dir/$file");
		}
		else
		{
		    unlink("$dir/$file")
		        or warn "Couldn't unlink $dir/$file: $!\n";
		}
            }
            elsif (-d(_))
            {
                &recurse_into("$dir/$file");
            }
	    elsif (-l(_) || -p(_) || -S(_) || -b(_) || -c(_))
	    {
	        unlink("$dir/$file") or warn "Couldn't unlink $dir/$file: $!\n";
	    }
            else
            {
	        die "Don't know how to handle $dir/$file!\n";
            }
	}
    }

    undef $dh;

    print STDERR "Removing directory $dir...\n" if ($debug);
    rmdir $dir || warn "Couldn't rmdir $dir: $!\n";
}

sub wipe
{
    my($file)=@_;
    my($size, $m);

    $size=-s $file;
    if ($size)
    {
        my $pass;
        foreach $m ("\xaa", "\x55", "\xff")
        {
            print STDERR "Overwriting $file, pass ", ++$pass, "...\n"
                if ($debug);
            &clobber($file, $size, $m);
        }
        print STDERR "Overwriting $file, final pass...\n" if ($debug);
        &clobber($file, $size, "\0");
    }
    print STDERR "Unlinking $file...\n" if ($debug);
    unlink($file) or warn "Couldn't unlink $file: $!\n";
}

sub clobber
{
    my($file, $size, $char)=@_;
    my($fh, $total, $foo, $block);

    $fh=new FileHandle "+<$file";
    binmode($fh);
    select((select($fh), $|=1)[0]);
    $total=0;
    while ($total<$size)
    {
       $foo=$size-$total;
       $block=($foo<4096 ? $foo : 4096);
       print $fh $char x $block;
       $total+=$block;
    }
    close($fh);
}
__END__

=head1 NAME

wipe - delete a file (or files) securely

=head1 SYNOPSIS

B<wipe> [I<-r>] I<file> [I<file> [I<...>]]

=head1 DESCRIPTION

B<wipe> securely deletes a file by first overwriting the file with a
pattern of 0xAA, 0x55, 0xFF, and 0x0, then unlinking the file.

If the I<-r> option is supplied, B<wipe> will recurse into any
directories specified on the command line.

=head1 EXAMPLES

The following example will wipe the files I<foo> and I<bar>:

    wipe foo bar

This example will recurse into I<baz> and wipe everything in it.  The
effect is similar to "rm -rf baz".

    wipe -r baz

=head1 AUTHOR

Steven Pritchard E<lt>steve@silug.orgE<gt>

=head1 SEE ALSO

B<rm>(1)

=head1 NOTES

If you want to be B<really> sure that your data won't be recovered,
try melting the disks down.  That seems to be pretty reliable.

=cut