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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
#!/usr/bin/perl -w
=head1 NAME
debinhex.pl - use Convert::BinHex to decode BinHex files
=head1 USAGE
Usage:
debinhex.pl [options] file ... file
Where the options are:
-o dir Output in given directory (default outputs in file's directory)
-v Verbose output (normally just one line per file is shown)
=head1 DESCRIPTION
Each file is expected to be a BinHex file. By default, the output file is
given the name that the BinHex file dictates, regardless of the name of
the BinHex file.
=head1 WARNINGS
Largely untested.
=head1 AUTHOR
Paul J. Schinder (NASA/GSFC) mostly, though Eryq can't seem to keep
his grubby paws off anything...
=cut
use lib "./lib";
use Getopt::Std;
use Convert::BinHex;
use POSIX;
use Fcntl;
use File::Basename;
use Carp;
require Mac::Files if ($^O||'' eq "MacOS");
use strict;
use vars qw(
$opt_o
$opt_v
);
my $DEBUG = 0;
#------------------------------------------------------------
# main
#------------------------------------------------------------
sub main {
# What usage?
@ARGV or usage();
getopts('o:v');
$DEBUG = $opt_v;
# Process files:
my $file;
foreach $file (@ARGV) {
debinhex($file);
}
}
exit(&main ? 0 : -1);
#------------------------------------------------------------
# usage
#------------------------------------------------------------
# Get usage from me.
sub usage {
my $msg = shift || '';
my $usage = '';
if (open(USAGE, "<$0")) {
while ($_ = <USAGE> and !/^=head1 USAGE/) {};
while ($_ = <USAGE> and !/^=head1/) {$usage .= $_};
close USAGE;
}
else {
$usage = "Usage unavailable; please see the script itself.";
}
print STDERR "\n$msg$usage";
exit -1;
}
#------------------------------------------------------------
# debinhex FILE
#------------------------------------------------------------
# Decode the given FILE.
#
sub debinhex {
my $inpath = shift || croak("No filename given $!");
local *BHEX;
my ($data, $testlength, $length, $fd);
print "DeBinHexing: $inpath\n";
# Open BinHex file:
open(BHEX,"<$inpath") || croak("Unable to open $inpath: $!");
# Create converter interface on stream:
my $hqx = Convert::BinHex->open(FH => \*BHEX);
# Read header, and output as string if debugging:
$hqx->read_header;
print $hqx->header_as_string if $DEBUG;
# Get output directory/filename:
my ($inname, $indir) = fileparse($inpath);
my $outname = $hqx->filename || 'NONAME';
my $outdir = $opt_o || $indir;
my $outpath = "$outdir/$outname"; $outpath =~ s{/+}{/}g;
# Create Mac file:
if ($^O||'' eq "MacOS") {
Mac::Files::FSpCreate($outpath, $hqx->creator, $hqx->type)
or croak("Unable to create Mac file $outpath");
}
# Get lengths of forks:
my $dlength = $hqx->data_length;
my $rlength = $hqx->resource_length;
# Write data fork:
print "Writing: $outpath\n";
$fd = POSIX::open($outpath, (&POSIX::O_WRONLY | &POSIX::O_CREAT), 0755);
$testlength = 0;
while (defined($data = $hqx->read_data)) {
$length = length($data);
POSIX::write($fd, $data, $length)
or croak("couldn't write $length bytes: $!");
$testlength += $length;
}
POSIX::close($fd) or croak "Unable to close $outpath";
croak("Data fork length mismatch: ".
"expected $dlength, wrote $testlength")
if $dlength != $testlength;
# Write resource fork?
if ($rlength) {
# Determine how to open fork file appropriately:
my ($rpath, $rflags);
if (($^O||'') eq "MacOS") {
$rpath = $outpath;
$rflags = (&POSIX::O_WRONLY | &POSIX::O_CREAT | &Fcntl::O_RSRC);
}
else {
$rpath = "$outpath.rsrc";
$rflags = (&POSIX::O_WRONLY | &POSIX::O_CREAT);
}
# Write resource fork...
$fd = POSIX::open($rpath, $rflags, 0755);
$testlength = 0;
while (defined($data = $hqx->read_resource)) {
$length = length($data);
POSIX::write($fd,$data,$length)
or croak "Couldn't write $length bytes: $!";
$testlength += $length;
}
POSIX::close($fd) or croak "Unable to close $rpath";
croak("Resource fork length mismatch: ".
"expected $rlength, wrote $testlength")
if $testlength != $rlength;
}
# Set Mac attributes:
if (($^O||'') eq "MacOS") {
my $has = Mac::Files::FSpGetCatInfo($outpath);
my $finfo = $has->{ioFlFndrInfo};
$finfo->{fdFlags} = $hqx->flags & 0xfeff; #turn off inited bit
$finfo->{fdType} = $hqx->type || "????";
$finfo->{fdCreator} = $hqx->creator || "????";
# Turn on the bundle bit if it's an application:
### $finfo->{fdFlags} |= 0x2000 if $finfo->{fdType} eq "APPL";
if ($DEBUG) {
printf("%x\n",$finfo->{fdFlags});
printf("%s\n",$finfo->{fdType});
printf("%s\n",$finfo->{fdCreator});
}
$has->{ioFlFndrInfo} = $finfo;
Mac::Files::FSpSetCatInfo($outpath, $has)
or croak "Unable to set catalog info $^E";
if ($DEBUG) {
$has = Mac::Files::FSpGetCatInfo ($outpath);
printf("%x\n",$has->{ioFlFndrInfo}->{fdFlags});
printf("%s\n",$has->{ioFlFndrInfo}->{fdType});
printf("%s\n",$has->{ioFlFndrInfo}->{fdCreator});
}
}
1;
}
#------------------------------------------------------------
1;
|
