Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

overwrite a file

by jdporter (Canon)
on Apr 25, 2007 at 22:04 UTC ( #612107=snippet: print w/ replies, xml ) Need Help??

Description:

This code shows how to completely overwrite the data of a file. (Actually, not sure if it will DWIM on sparse files.)

The technique is illustrated in a sample practical application: "securely" erase and delete a file. (Note: does not securely erase and delete a file.)

use Fcntl;
use strict;
use warnings;

my $blocksize = 2048;

sub overwrite_file($;$)
{
    my( $filename, $pattern ) = @_;
    -e $filename or die "File '$filename' does not exist.\n";
    my $filesize = -s $filename;

    local *F;
    sysopen F, $filename, O_RDWR|O_BINARY
        or die "Can't overwrite '$filename' - $!\n";

    if ( defined $pattern and length $pattern )
    {
        $pattern x= 1 + $blocksize / length $pattern;
        substr( $pattern, $blocksize ) = '';

        my $written = 0;
        $written += syswrite F, $pattern
            while $written < $filesize;
    }
    else
    {    # use random bytes
        $pattern = "\0" x $blocksize;
        my $written = 0;
        while ( $written < $filesize )
        {
            $pattern =~ s/(.)/ $1 ^ chr(rand 256) /seg;
            $written += syswrite F, $pattern;
        }
    }

    #sysseek F, 0, 0; # rewind
    close F;
}

sub shred_file($)
{
    my $filename = shift;

    overwrite_file $filename, $_ for
        # byte patterns:
        "\xA5",
        "\x5A",
        '',     # random bytes
        "\x00",
        "\xFF";

    unlink $filename or die "Can't delete '$filename' - $!\n";
}

@ARGV or die "Usage: $0 file file ...\n";
shred_file $_ for @ARGV;

Comment on overwrite a file
Download Code
Re: overwrite a file
by ikegami (Pope) on Apr 25, 2007 at 23:56 UTC

    I'm not familiar with the implementations of OS disk caching, but it seems to me there's no guarantee that any but the last call to overwrite_file makes it to disk from the system's cache. Even then... With a particularly good cache, absolutely nothing would be written to disk.

    Remember, sys* disables user-land caching. It doesn't prevent OS caching. FILE_FLAG_NO_BUFFERING would do that in Windows, but I see no reference to it in win32/win32io.c in perl.git.

      The approach is simple and granular. However I would agree with ikegami that system cache may work against you. In *nx systems you might consider to call sync after each file close call to have the system clean out its disk cache.

      For the really paranoid among us other things that may influence success are i.e. disk controller internal caches, cache issues with remote filesystems mounted over network, parallel read/writes on the file by another process. Besides those caching aspects you need to consider filesystem type, as your data may still live in the journal logs.

      Bottomline: Solid erasure of data on a granular level like files is always tricky.

        Bottomline: Solid erasure of data on a granular level like files is always tricky.
        Agreed. However, secure shredding on disk level is less tricky, albeit cumbersome, as seen here.
        --
        print map{chr}unpack(q{A3}x24,q{074117115116032097110111116104101114032080101114108032104097099107101114})
      sys* disables user-land caching. It doesn't prevent OS caching.

      Good point. In Windowsland, if the the device being written is a removable type (such as a USB drive), then one can simply disable disk write caching. This worked just fine for me.

      A word spoken in Mind will reach its own level, in the objective world, by its own weight

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://612107]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (12)
As of 2014-11-24 09:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (137 votes), past polls