http://www.perlmonks.org?node_id=136337
Category: Cryptography
Author/Contact Info L. Wells
Description: A quick-and-dirty script I whipped up to securely delete files up to and beyond Orange Book standards. The default is seven passes over overwriting first with 0's, then with 1's, then with a cryptographically secure mechanism (In this case, blowfish using /dev/urandom). It is very messy, in that it uses /dev/urandom for all of its input, so on a very large file (or after many files), the entropy will become less and less random, but I'll likely do something about that when I get some time. Any other input would be appreciated.
#!/usr/bin/perl -w
#
#
#
# Shred.pl 0.5 by L. Wells
# Secure file deletion utility
# Licensed under the GPL (http://www.opensource.org/licenses/gpl-licen
+se.html)
# December 28, 2001
#
#
#
#
# TODO:
# Finish support for other encryption algorithms.
# Add annoying little progress bar type things.
#
#
#

use IO::File;
use Crypt::Blowfish;
use Getopt::Std;
use strict;

my $filename;
my $verbose = 0;

my %opts;
getopts("vVha:f:i:", \%opts);

if ($opts{f}) {
        $filename=$opts{f} or die "No file specified $!";
        }

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

if ($opts{h} || !$opts{f}) {
        do_help();
        }

if ($opts{V}) {
        $verbose = 1;
        }

my $keysize=56;
my $blocksize=8;
my $random=1;
my $iterations=7;
my $entropyfile="/dev/urandom";
my $null=chr(0);
my $one=chr(255);
my $the_key = gather_entropy($keysize);
my $cipher = new Crypt::Blowfish $the_key;
my $b;
my $i;
my $size = (stat($filename))[7] or die "no $filename: $!";

sub nuke_file($);
sub do_version;
sub do_help;



if ($opts{i}) {
        $iterations=$opts{i};
        }


for ($b=1;$b <=$iterations;$b++) {

        if ($verbose) {
                print "Wipe iteration $b\n";
                }
        nuke_file($null);
        if ($verbose) {
                print "Null wipe $b\n";
                }
        nuke_file($one);
        if ($verbose) {
                print "One wipe $b\n";
                }
        nuke_file($random);
        if ($verbose) {
                print "Crypt wipe $b\n";
                }
}

unlink ($filename);

if ($verbose) {
        print "Wipe finished. Completed $iterations iterations\n";
        }


sub do_cipherstring {

my $outchar = gather_entropy($blocksize);

my $cipherout = $cipher->encrypt($outchar);

return $cipherout;

}


sub gather_entropy {

        my $bytes=$_[0];
        my $entropy_bytes;

        sysopen (ENTROPY, $entropyfile, O_RDONLY);

        sysread(ENTROPY, $entropy_bytes, $bytes);

        close(ENTROPY);

        return $entropy_bytes;

}



sub nuke_file ($){

        my $o_w = $_[0];

        sysopen(BYEBYE, $filename, O_WRONLY) or die $!;

        for ($i=0;$i<($size/$blocksize);$i++) {

                if ($o_w ne $null && $o_w ne $one) {
                $o_w=do_cipherstring;
                }

        my $err = syswrite(BYEBYE, $o_w, $blocksize, 0) or die $!;

        my $bytes += $err;

        }

close(BYEBYE);

}

sub do_version {
        print "Shred.pl 0.5 by L. Wells\n\n";
        exit(1);
        }

sub do_help {
        print "Shred.pl 0.5 by L. Wells\n";
        print "Usage: Shred.pl -f filename [-i iterations] [-a algorit
+hm] [-vVh]\n";
        print "\t-f filename\tWhere filename is the file to be nuked.\
+n";
        print "\t-i iterations\tWhere iterations are the number of pas
+ses for overwriting.\n";
        print "\t-v\t\tPrint version information and exit.\n";
        print "\t-a algorithm\tSpecify which algorithm to use for cryp
+to pass. (NOT IMPLEMENTED)\n";
        print "\t-V\t\tVerbose mode. Shows more detailed information (
+Default is no output).\n";
        print "\t-h\t\tHelp. Prints this help information.\n\n";
        exit(1);
        }
Replies are listed 'Best First'.
Re: Shred
by grinder (Bishop) on Jan 07, 2002 at 04:34 UTC
    You ask for input, so, here goes

    • You are using an indentation of 8 characters. This is not just a style issue, it actually makes the code harder to apprehend rather than using 2, 3 or 4 character indents. I believe the seminal reference on the matter is Steve Connell's "Code Complete". In fact the indentation is a bit borked in places, you should run it through Perltidy or similar pretty printer to get things into line.

    • The variables $b and $i appear to be used only to count interations, and the iterations are governed by a C-style for loop. A more perlish idiom would be something like
      my $iter = 0; while( $iter++ < $MAX_ITERS ) { do_stuff(); }

      In any event, you have to get rid of the globals. Many of them are needed only for nuke_file(), so define them there, or wrap them up in tight scopes like:

      { my $block_size = 207; sub get_block_size { $block_size } }
      This means that once you leave the scope, you can no longer change the block size, you can only retrieve it. Which is just what you want.

    • The main problem with the code is with the sub nuke_file. You are passing in a modal variable that controls how the subroutine is to behave. This is a maintenance nightmare. What does it have to do? Write a stream of bytes equal to the length of that file. What does the stream of bytes contain? Who cares? What if you want to add 01010101 and/or 10101010 as possible bit streams? A different random stream (such as /dev/random or /dev/srandom, i.e. a random stream that blocks if you drain the entropy pool)?

      The most open-ended way to deal with this problem is to pass the subroutine a callback. You open the file, and then call the callback for each block of data you want to write (although I would choose a default block size of 4096 bytes rather than 8). A rough sketch would look something like

      sub nuke_file { my $file = shift; my $cb = shift or die "No callback specified to nuke_file().\n"; die "$cb is not a coderef in nuke_file()\n" unless ref($cb) eq 'CO +DE'; my $file_size = (stat($file))[7]; my $bytes = 0; my $block_size = get_block_size(); sysopen(BYEBYE, $file, O_WRONLY) # be descriptive in your die string or die "Could not open $file for output: $!\n"; while( $bytes < $file_size ) { # deal with the tail end of the file correctly my $len = $bytes + $block_size > $file_size ? $file_size - $bytes : $block_size; my $written = syswrite(BYEBYE, &$cb( $len ), $len, 0) or die "Could not write $len bytes to $file: $!"; my $bytes += $written; # $err is a misleading name } close(BYEBYE); }


    • This would then get rid of the ugly hacks $one and $null, which I found to have misleading names. Naming them $all_ones and $all_zeros would be closer to the point. I don't know if I'm alone in the following, but I find $all_ones = chr(255) less clear than simply $all_ones = 0xff, that may be my background, but the use of chr sort of shouts out ASCII! Unportability! to me. And there may be yet a better way.

      A sample callback would look like

      sub all_ones { 0xff x $_[0]; } nuke_file( $filename, \&all_ones );

      This approach would also let you gracefully degrade performance if Crypt::Blowfish was not available. And conversely, use any Crypt::* module that you know of that performs block ciphering.

    • Use the ||= defaulting operator, such as in
      my $iterations = $opts{i} || 7

    • In a raft of assignments, use whitespace to align the = characters. It takes more time, and is a bear to fix should you add a longer variable name to the batch, but it improves the readability.

    • sysopen and sysread are in general rarely needed. Do you need the functionality they provide (bypassing buffering, no partial read lengths spring to mind) or will open and read do? If you can, the program will be a better player in its environment.

    • In sub do_help all those prints would be better replaced by a simple heredoc. If you're worried about the interpolation of @gmx, you can always use the <<'HEREDOC' form to specify single quote semantics (no interpolation).

    • The Orange Book standard recommends, from dim memory, overwriting by all 0s, all 1s, and then 1 to 9 times with a random bit pattern (the emphasis being on 1 to 9).

    --
    g r i n d e r
    print@_{sort keys %_},$/if%_=split//,'= & *a?b:e\f/h^h!j+n,o@o;r$s-t%t#u';