aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/utils/beam_strip
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /erts/emulator/utils/beam_strip
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'erts/emulator/utils/beam_strip')
-rwxr-xr-xerts/emulator/utils/beam_strip89
1 files changed, 89 insertions, 0 deletions
diff --git a/erts/emulator/utils/beam_strip b/erts/emulator/utils/beam_strip
new file mode 100755
index 0000000000..1ce0fea180
--- /dev/null
+++ b/erts/emulator/utils/beam_strip
@@ -0,0 +1,89 @@
+#!/usr/bin/env perl
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+use strict;
+
+for (@ARGV) {
+ open(IN, "<$_") or do {warn "skipping $_:$!\n"; next};
+ my $data;
+ sysread(IN, $data, 10000000);
+ close IN;
+ my $new_file = eval {slim_beam($data)};
+ open(OUT, ">$_") or die "Failed to write $_:$!\n";
+ print OUT $new_file;
+ close OUT;
+}
+
+# Bug in 5.6.0: The following doesn't work.
+#local $/;
+#while (<>) {
+# my $new_file = eval {slim_beam($_)};
+# if ($@) {
+# ...
+# } else {
+# ...
+# }
+#}
+
+sub slim_beam {
+ my($beam) = @_;
+ my $size_left = length($beam);
+ my @chunk;
+
+ die "can't read Beam files for OTP R4 or earlier (sorry)"
+ if $beam =~ /^\x7fBEAM!/;
+
+ #
+ # Read and verify the head of the IFF file.
+ #
+
+ my ($id, $size, $beam_id) = unpack("a4Na4", $beam);
+ die "not a BEAM file: no IFF 'FOR1' chunk"
+ unless $id eq 'FOR1';
+ $size_left -= 8;
+ die "form size $size greater than size ", $size_left, " of module"
+ if $size > $size_left;
+ $size_left -= 4;
+ die "not a BEAM file: IFF form type is not 'BEAM'"
+ unless $beam_id eq 'BEAM';
+
+ #
+ # Read all IFF chunks.
+ #
+
+ $beam = substr($beam, 12, $size_left);
+ while ($size_left > 0) {
+ ($id, $size) = unpack("a4N", $beam);
+ $size_left -= 8;
+ die "chunk size $size greater than size ", $size_left, " of module"
+ if $size > $size_left;
+ $size = 4*int(($size+3)/4);
+ my $chunk = substr($beam, 0, $size+8);
+ $beam = substr($beam, 8+$size);
+ $size_left = length($beam);
+ push(@chunk, $chunk)
+ unless $id eq 'LocT' || $id eq 'CInf';
+ }
+
+ #
+ # Create new Beam file.
+ #
+ my $new_file = join('', @chunk);
+ "FOR1" . pack("N", length($new_file)+4) . "BEAM" . $new_file;
+}