1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
#!/usr/bin/env perl
use strict;
use warnings;
use File::Temp qw( tempdir tempfile );
use Archive::Any;
use File::LibMagic;
use Path::Class;
# This program will replace the content of any files contained in a tar,
# tar.gz or zip archive by random noise, while preserving the permissions
# and ownership (assuming all files in the archive have the same owner as
# the first file).
#
# It will skip unrecognized files. It requires GNU tar for extracting
# the archives and bsdtar for repacking them.
#
# Usage: anonymize-archives file ...
my $magic = File::LibMagic->new;
# process files given on the command line
while ( my $file = shift ) {
# open the archive
my $archive = eval {
local $SIG{__WARN__} = sub { }; # no warnings from Archive::Any
Archive::Any->new($file);
} or do {
print STDERR "Skipping $file\n";
next;
};
my $type = $archive->type;
print STDERR "Processing $file ($type)\n";
# get the list of files
my @files = $archive->files;
# extract the archive in a temporary directory
my $dir = tempdir( CLEANUP => 1 );
# re-create an archive with same files and dummy content
my $tmp = "$file.tmp";
if ( $type eq 'tar' ) {
# save differently if compressed
my ($mime) = split ';', $magic->checktype_filename($file);
my $gzip = $mime eq 'application/x-gzip' ? 'z' : '';
# record list of files for tar
( undef, my $list ) = tempfile( UNLINK => 1 );
file($list)->spew(
[ map +( $archive->is_naughty ? substr( $_, 1 ) : $_ ) . "\n",
@files
]
);
# extract archive
`tar x${gzip}f $file -C $dir --delay-directory-restore`;
# replace all file content with random data
my @mtime;
for my $path (@files) {
my $mode;
my $member = file( $dir, $path );
unshift @mtime, [ ( ( stat $member )[9] ) x 2, "$member" ];
next if -d $member;
if ( !-w $member ) {
$mode = ( stat $member )[2] if !-w $member;
chmod 0644, $member;
}
$member->spew( pack "C*", map rand 256, 1 .. -s $member );
chmod $mode, $member if $mode;
}
# restore date and time
utime @$_ for @mtime;
# pick up owner and group
my $iter = Archive::Tar->iter($file);
my $member = $iter->();
my @opts = (
'--uid' => $member->uid,
'--uname' => $member->uname,
'--gid' => $member->gid,
'--gname' => $member->gname,
( '-s', ':^:/:', '--absolute-paths' )x!! $archive->is_naughty,
);
# repack the file
`bsdtar -c${gzip}f $tmp -C $dir -T $list --no-recursion @opts`;
}
elsif ( $type eq 'zip' ) {
# read the list of files and their properties
my $old = Archive::Zip->new;
$old->read($file) and do { warn "Error reading $file\n"; next };
my @members = $old->members();
# create a new zip file with dummy content
my $zip = Archive::Zip->new;
for my $member (@members) {
$member->contents(
pack "C*",
map rand 256,
1 .. $member->uncompressedSize
);
$zip->addMember($member);
}
# save the new zip
$zip->writeToFileNamed($tmp);
}
else {
print STDERR "Skipping $file ($type)\n";
next;
}
# replace archive
rename $tmp, $file;
}
|
