#!/usr/bin/perl -w

# 
# Wiper 0.3 by Thomas Sjogren (thomas@northernsecurity.net).
# Utility to overwrite the free space on a hdd.
# Released under GPL version 2 (http://www.gnu.org/licenses/gpl.txt).
# 
# October 2002
#
# Additional information:
# Peter Gutmann, Secure Deletion of Data from Magnetic and Solid-State
# Memory, http://www.cs.auckland.ac.nz/~pgut001/pubs/secure_del.html
#
# DoD 5220.22-M (NISPOM), chapter 8, "Clearing and Sanitization 
# Matrix", http://www.dss.mil/isec/nispom.htm
#

use Getopt::Std;

 srand (time ^ $$ ^ unpack "%32L*", `ps wwaxl | gzip`);

 @letters = ('A' .. 'Z', 'a' .. 'z', '0' .. '9', '.');
 $file = "." . $letters[rand@letters] . $letters[rand@letters] .  
            $letters[rand@letters] . $letters[rand@letters];

my $version=0.3;
my %opts;
getopts("vhm:rsdg", \%opts);

    if ($opts{v}){
        version();
        }

    if ($opts{h} || !$opts{m}){
        help();
        }

    if ($opts{m}){
        $bits=($opts{m} * 1048576) || die "No size specified $!";
        }

    if ($opts{r}){
        random();
        }

    if ($opts{s}){
        six();
        }

    if ($opts{d}){
        dod();
        }

    if ($opts{g}){
        gutmann();
        }

sub version {
    print "Wiper version $version\n";
    exit(1);
    }

sub help {
    print "\nWiper $version\n";
    print "Usage: wiper.pl [type] -m [megabytes]\n";
    print "Types:\n";
    print "\t-r One random layer overwrite\n";
    print "\t One random character\n";
    print "\t-s Six layers\n";
    print "\t 0x92,0x49,0x24,0x6D,0xB6,0xDB\n";
    print "\t-d Seven layers\n";
    print "\t 0x00,0xFF,three random,0xFF,0x00\n";
    print "\t-g 35 layers\n";
    print "\t Gutmann method\n\n";
    print "Misc:\n";
    print "\t-v Version\n";
    print "\t-h This help message\n\n";
    print "Example:\n";
    print "\t./wiper.pl -g -m 300\n\n";
    exit(1);
    }

sub random {
    print STDOUT "One random layer overwrite : $opts{m}M\n";

    open TMP, "> $file" || die "Error: $!";

    print TMP chr(rand(0xFF)) x $bits;
    seek(TMP,0,0);

    close TMP;
    unlink("$file");

    print STDOUT "Done.\n";
    }

sub six {
    print STDOUT "Six layer overwrite : $opts{m}M\n"; 

    open TMP, "> $file" || die "Error: $!";

    print TMP (chr(0x92),chr(0x49),chr(0x24)) x ($bits / 3); 
    seek(TMP,0,0);

    print TMP (chr(0x49),chr(0x24),chr(0x92)) x ($bits / 3);
    seek(TMP,0,0);

    print TMP (chr(0x24),chr(0x92),chr(0x49)) x ($bits / 3);
    seek(TMP,0,0);

    print TMP (chr(0x6D),chr(0xB6),chr(0xDB)) x ($bits / 3); 
    seek(TMP,0,0);

    print TMP (chr(0xB6),chr(0xDB),chr(0x6D)) x ($bits / 3);
    seek(TMP,0,0);

    print TMP (chr(0xDB),chr(0x6D),chr(0xB6)) x ($bits / 3);
    seek(TMP,0,0);

    close TMP;
    unlink("$file");

    print STDOUT "Done.\n";
    }

sub dod {
    print STDOUT "Seven layer overwrite: $opts{m}M\n";
    
    open TMP, "> $file" || die "Error: $!";

    print TMP chr(0x00) x $bits;
    seek(TMP,0,0);

    print TMP chr(0xFF) x $bits;
    seek(TMP,0,0);

    print TMP chr(rand(0xFF)) x $bits;
    seek(TMP,0,0);

    print TMP chr(rand(0xFF)) x $bits;
    seek(TMP,0,0);

    print TMP chr(rand(0xFF)) x $bits;
    seek(TMP,0,0);

    print TMP chr(0xFF) x $bits;
    seek(TMP,0,0);

    print TMP chr(0x00) x $bits;
    seek(TMP,0,0);

    close TMP;
    unlink("$file");

    print STDOUT "Done.\n";
    }

sub gutmann {
    print STDOUT "35 layer overwrite: $opts{m}M\n";

    open TMP, "> $file" || die "Error: $!";
    
    print TMP chr(rand(0xFF)) x $bits;
    seek(TMP,0,0);

    print TMP chr(rand(0xFF)) x $bits;
    seek(TMP,0,0);

    print TMP chr(rand(0xFF)) x $bits;
    seek(TMP,0,0);

    print TMP chr(rand(0xFF)) x $bits;
    seek(TMP,0,0);

    print TMP chr(0x55) x $bits;
    seek(TMP,0,0);

    print TMP chr(0xAA) x $bits;
    seek(TMP,0,0);

    print TMP (chr(0x92),chr(0x49),chr(0x24)) x ($bits / 3); 
    seek(TMP,0,0);

    print TMP (chr(0x49),chr(0x24),chr(0x92)) x ($bits / 3);
    seek(TMP,0,0);

    print TMP (chr(0x24),chr(0x92),chr(0x49)) x ($bits / 3);
    seek(TMP,0,0);

    print TMP chr(0x00) x $bits;
    seek(TMP,0,0);

    print TMP chr(0x11) x $bits;
    seek(TMP,0,0);

    print TMP chr(0x22) x $bits;
    seek(TMP,0,0);

    print TMP chr(0x33) x $bits;
    seek(TMP,0,0);

    print TMP chr(0x44) x $bits;
    seek(TMP,0,0);

    print TMP chr(0x55) x $bits;
    seek(TMP,0,0);

    print TMP chr(0x66) x $bits;
    seek(TMP,0,0);

    print TMP chr(0x77) x $bits;
    seek(TMP,0,0);

    print TMP chr(0x88) x $bits;
    seek(TMP,0,0);

    print TMP chr(0x99) x $bits;
    seek(TMP,0,0);

    print TMP chr(0xAA) x $bits;
    seek(TMP,0,0);

    print TMP chr(0xBB) x $bits;
    seek(TMP,0,0);

    print TMP chr(0xCC) x $bits;
    seek(TMP,0,0);

    print TMP chr(0xDD) x $bits;
    seek(TMP,0,0);

    print TMP chr(0xEE) x $bits;
    seek(TMP,0,0);

    print TMP chr(0xFF) x $bits;
    seek(TMP,0,0);

    print TMP (chr(0x92),chr(0x49),chr(0x24)) x ($bits / 3);
    seek(TMP,0,0);

    print TMP (chr(0x49),chr(0x24),chr(0x92)) x ($bits / 3);
    seek(TMP,0,0);

    print TMP (chr(0x24),chr(0x92),chr(0x49)) x ($bits / 3);
    seek(TMP,0,0);

    print TMP (chr(0x6D),chr(0xB6),chr(0xDB)) x ($bits / 3); 
    seek(TMP,0,0);

    print TMP (chr(0xB6),chr(0xDB),chr(0x6D)) x ($bits / 3);
    seek(TMP,0,0);

    print TMP (chr(0xDB),chr(0x6D),chr(0xB6)) x ($bits / 3);
    seek(TMP,0,0);

    print TMP chr(rand(0xFF)) x $bits;
    seek(TMP,0,0);

    print TMP chr(rand(0xFF)) x $bits;
    seek(TMP,0,0);

    print TMP chr(rand(0xFF)) x $bits;
    seek(TMP,0,0);

    print TMP chr(rand(0xFF)) x $bits;
    seek(TMP,0,0); 

    close TMP;
    unlink("$file");

    print STDOUT "Done.\n";
    }
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.