#!/usr/local/bin/perl -w
# wipe.pl -- Ueberschreibt Dateien vor dem 'physischen' Loeschen.

use Fcntl;                       # Wegen der O_*-Konstanten

foreach my $file (@ARGV) {
    my ($nlink, $size, $blksize);

    # Datei zum Schreiben oeffnen.
    # Beachte: O_SYNC zum sofortigen Schreiben auf Platte!
    unless (sysopen(WIPEIT, $file, O_WRONLY | O_SYNC)) {
    warn "can't wipe $file: $!\n";
        next;
    }

    # <- Konkurrenzschlitz -> (Race condition)

    # Verzeichniseintrag schon jetzt loeschen!
    unless (unlink($file)) {
    warn "can't unlink $file: $!\n";
        next;
    }

    # Wir brauchen einige Metadaten...
    unless (($nlink, $size, $blksize) = (stat(WIPEIT))[3,7,11]) {
    warn "can't stat $file (not wiped): $!\n";
        next;
    }

    # Kurze Warnung, falls weitere echte Links vorhanden sind:
    warn "$file has still $nlink names!" if $nlink and $^W;

    # Datei physikalisch ueberschreiben
    wipe(\*WIPEIT, $size, $blksize);

    # Wenn wir der letzte Prozess sind, wird die Datei jetzt geloescht
    close(WIPEIT);
}

# wipe() loescht $size Bytes, indem es sie mit \0 ueberschreibt.
# Es wird moeglichst effizient in $blksize Bloecke geschreiben.
sub wipe {
    my $fh      = shift;
    my $size    = shift;
    my $blksize = shift;
    my $buf     = "\0" x $blksize;     # Ueberschreibpuffer
    my ($written, $nbytes);
    
    for($written=0;
           $written < $size and
           defined($nbytes=syswrite($fh, $buf, $blksize));
        $written += $nbytes) { }
}