#!/usr/bin/perl
use warnings;
use strict 'subs';
package mp4nerf;
$action = 'nerf'; # default when called from anri
{ no warnings 'once'; *anri::mp4nerf = *mp4nerf; }
exit &mp4batchnerf(@ARGV) unless defined caller();
sub mp4batchnerf {
$verbose = 1;
$action = 'print'; # default when called stand-alone
&pout("MP4 audio track disabler\n");
&pout("beta 0.2, DJ Grenola & SelbyMD\n\n");
&pout("This software comes with no warranty.\n\n");
unless (grep {-e} @_) {
&perr("Usage: mp4nerf.pl <MP4 file> [ <MP4 file> ... ] to print track information\n");
&perr("Usage: mp4nerf.pl -n <MP4 file> [ <MP4 file> ... ] to disable commentary\n");
&perr("Usage: mp4nerf.pl -u <MP4 file> [ <MP4 file> ... ] to re-enable commentary\n");
return 1;
}
for $arg (@_) {
if ($arg eq '-p') { $action = 'print' }
elsif ($arg eq '-u') { $action = 'unnerf' }
elsif ($arg eq '-n') { $action = 'nerf' }
elsif ($arg eq '-x') { $action = 'nerf' }
else { $files++; $errors += &mp4nerf($arg) }
}
if ($errors) {
&perr("[-] There were errors during processing. [${errors}/${files}]\n");
} else {
&pout("[+] All files processed successfully.\n");
}
return $errors;
}
sub mp4nerf {
$mp4file = shift;
$matches = 0;
$tracks_to_skip = ($action eq 'nerf') ? 1 : 0;
unless (open(FH, '+<:raw', $mp4file)) {
&perr(qq([-] Failed to open file "${mp4file}".\n\n));
return 1;
}
&pout(qq([+] Scanning file "${mp4file}".\n));
@traks = &getatomtree([qw(moov trak)], [0, -s $mp4file]);
unless (@traks) {
&perr(qq([-] No tracks found. Maybe this isn't an mp4 file.\n\n));
close(FH);
return 1;
}
for $trak (@traks) {
($tkhd) = &getatoms('tkhd', @$trak);
($offset, $id, $status, $type) = ($$tkhd[0], &id($tkhd), &status($tkhd), &type($trak));
unless (defined($id) and defined($status)) {
&perr(qq([-] Error reading from file "${mp4file}".\n\n));
close(FH);
return 1;
}
printf("[+] Track %d (%7s,%8s) at 0x%08x, ", $id, $type, $status, $$trak[0] - 8) if $verbose;
if ($type ne 'audio') {
&pout("ignored.\n");
} elsif (++$matches <= $tracks_to_skip) {
&pout("skipped.\n");
} elsif (($action eq 'nerf') and ($status eq 'enabled')) {
&pout("attempting to disable ...\n");
if (nerf($offset)) {
&pout("[+] Nerfed successfully.\n");
} else {
&perr("[-] Failed to nerf this track.\n\n");
close(FH);
return 1;
}
} elsif (($action eq 'unnerf') and ($status eq 'disabled')) {
&pout("attempting to enable ...\n");
if (unnerf($offset)) {
&pout("[+] Unnerfed successfully.\n");
} else {
&perr("[-] Failed to unnerf this track.\n\n");
close(FH);
return 1;
}
} else {
&pout("no action taken.\n");
}
}
&pout(qq([+] File "$mp4file" processed successfully.\n\n));
close(FH);
return 0;
}
sub pout { print STDOUT @_ if $verbose }
sub perr { print STDERR @_ }
sub myread { sysseek(FH, $_[1], 0) and ( sysread(FH, $_[0], $_[2]) == $_[2]) }
sub mywrite { sysseek(FH, $_[1], 0) and (syswrite(FH, $_[0], $_[2]) == $_[2]) }
sub nerf { &myread($temp, $_[0] + 3, 1) and &mywrite(pack('C', unpack('C', $temp) & 0xFE), $_[0] + 3, 1) }
sub unnerf { &myread($temp, $_[0] + 3, 1) and &mywrite(pack('C', unpack('C', $temp) | 0x01), $_[0] + 3, 1) }
sub isvideo { &getatomtree([qw(mdia minf vmhd)], $_[0]) }
sub isaudio { &getatomtree([qw(mdia minf smhd)], $_[0]) }
sub type { &isaudio ? 'audio' : &isvideo ? 'video' : 'unknown' }
sub id { &myread($temp, $_[0][0] + 12, 4) ? unpack('N', $temp) : 0 }
sub status { &myread($temp, $_[0][0] + 3, 1) ? ((unpack('C', $temp) % 2) ? 'enabled' : 'disabled') : undef }
sub getatoms {
($atomname, $start, $end) = @_;
@atoms = ();
use bytes;
while ($start < $end) {
last unless &myread($temp, $start, 8);
($size, $name) = unpack('NA4', $temp);
if ($size == 1) { # might not have 'Q', so do this manually
last unless &myread($temp, $start + 8, 8);
$size = unpack('N', substr($temp, 0, 4)) * 2**32 + unpack('N', substr($temp, 4, 4));
if ($size < 16) { $size = (-s $mp4file) - $start }
if ($name eq $atomname) { push @atoms, [$start + 16, $start + $size] }
} else {
if ($size < 8) { $size = (-s $mp4file) - $start }
if ($name eq $atomname) { push @atoms, [$start + 8, $start + $size] }
}
$start += $size;
}
@atoms;
}
sub getatomtree {
@tree = ($_[1]);
for my $atomname (@{$_[0]}) {
last unless @tree;
@tree = map { &getatoms($atomname, @$_) } @tree;
}
@tree;
}
1;