|
|
@@ -0,0 +1,531 @@
|
|
|
+#!/usr/bin/perl
|
|
|
+#
|
|
|
+# Simple tool for generating a USB desciptor table or ROM/RAM
|
|
|
+#
|
|
|
+
|
|
|
+use integer;
|
|
|
+use strict;
|
|
|
+use File::Spec;
|
|
|
+use Encode;
|
|
|
+
|
|
|
+require 'langid.ph';
|
|
|
+
|
|
|
+# Descriptor types. This follows the document in which they were specified;
|
|
|
+# some USB documents specify in hex and others in decimal...
|
|
|
+our %DT = (
|
|
|
+ 'device' => 1,
|
|
|
+ 'configuration' => 2, 'config' => 2, 'conf' => 2,
|
|
|
+ 'string' => 3, 'str' => '3',
|
|
|
+ 'interface' => 4, 'if' => '4',
|
|
|
+ 'endpoint' => 5, 'ep' => 5,
|
|
|
+ 'device_qualifier' => 6, 'dq' => 6,
|
|
|
+ 'other_speed_configuration' => 7, 'otherspeed' => 7, 'osc' => 7,
|
|
|
+ 'interface_power' => 8, 'ifpwr' => 8,
|
|
|
+ 'otg' => 9,
|
|
|
+ 'debug' => 10,
|
|
|
+ 'interface_association' => 11, 'iad' => 11,
|
|
|
+
|
|
|
+ 'bos' => 15, 'binary_object_storage' => 15,
|
|
|
+ 'device_capability' => 16, 'devcap' => 16,
|
|
|
+
|
|
|
+ 'cs_interface' => 0x24, 'cs_if' => 0x24,
|
|
|
+ 'cs_endpoint' => 0x25, 'cs_ep' => 0x25,
|
|
|
+
|
|
|
+ 'superspeed_usb_endpoint_companion' => 48, 'usb_ep_companion' => 48,
|
|
|
+ 'superspeedplus_isochronous_endpoint_companion' => 49, 'iso_ep_compation' => 49,
|
|
|
+ );
|
|
|
+
|
|
|
+# Descriptor subtypes, where applicable
|
|
|
+our %DS = (
|
|
|
+ # Under CS_INTERFACE
|
|
|
+ 0x24 => {
|
|
|
+ 'header' => 0x00,
|
|
|
+ 'call' => 0x01, 'call_management' => 0x01,
|
|
|
+ 'abstract_control' => 0x02, 'acm' => 0x02,
|
|
|
+ 'direct_line' => 0x03,
|
|
|
+ 'ringer' => 0x04,
|
|
|
+ 'line_state' => 0x05,
|
|
|
+ 'union' => 0x06,
|
|
|
+ 'country' => 0x07,
|
|
|
+ 'op_mode' => 0x08,
|
|
|
+ 'terminal' => 0x09,
|
|
|
+ 'net_channel' => 0x0a,
|
|
|
+ 'protocol_unit' => 0x0b,
|
|
|
+ 'extension_unit' => 0x0c,
|
|
|
+ 'multi_channel' => 0x0d,
|
|
|
+ 'capi' => 0x0e,
|
|
|
+ 'ethernet' => 0x0f,
|
|
|
+ 'atm' => 0x10,
|
|
|
+ 'whcm' => 0x11, 'wireless_handset' => 0x11,
|
|
|
+ 'mobile_line' => 0x12, 'mobile_direct_line' => 0x12,
|
|
|
+ 'mdlm_detail' => 0x13, 'mdlm' => 0x13,
|
|
|
+ 'device_management' => 0x14, 'device' => 0x14, 'mgmt' => 0x14,
|
|
|
+ 'command_set' => 0x16,
|
|
|
+ 'command_set_detail' => 0x17,
|
|
|
+ 'telephone_control' => 0x18, 'tcm' => 0x18, 'phone' => 0x18,
|
|
|
+ 'obex_service_identifier' => 0x19, 'obex' => 0x19
|
|
|
+ }
|
|
|
+ );
|
|
|
+
|
|
|
+#
|
|
|
+# Class, subclass, and protocol codes. Map a string to a number, then
|
|
|
+# use that number as an index to descend, if that entry exists. 0 is
|
|
|
+# the default; for some classes the subclass code is unused and so is
|
|
|
+# set to 0; no string to look up.
|
|
|
+#
|
|
|
+# Numbers below the class level are massively incomplete, feel free to add.
|
|
|
+#
|
|
|
+
|
|
|
+# Applies to all levels
|
|
|
+my %class_all_levels = (
|
|
|
+ undef => 0x00, 'undef' => 0x00, '-' => 0x00,
|
|
|
+ 'none' => 0x00, 'default' => 0x00,
|
|
|
+ 'vendor_specific' => 0xff, 'vendor' => 0xff,
|
|
|
+ );
|
|
|
+
|
|
|
+my $cdc_pstn_protocols = {
|
|
|
+ 'v250' => 0x01, 'at' => 0x01, 'v25ter' => 0x01,
|
|
|
+ 'pcca101' => 0x02,
|
|
|
+ 'pcca101o' => 0x03, 'pcca' => 0x03,
|
|
|
+ 'gsm707' => 0x04, 'gsm' => 0x04,
|
|
|
+ '3gpp2707' => 0x05, '3gpp' => 0x05, '3g' => 0x05,
|
|
|
+ 'ca00170' => 0x06, 'tia_cdma' => 0x06, 'cdma' => 0x06
|
|
|
+};
|
|
|
+
|
|
|
+my %class_codes = (
|
|
|
+ 'multi' => 0x00, # Real class code in interface descriptors
|
|
|
+ 'audio' => 0x01,
|
|
|
+ 'cdc' => 0x02, 'communications' => 0x02,
|
|
|
+ 0x02 => {
|
|
|
+ 'dlcm' => 0x01, 'direct_line_control' => 0x01,
|
|
|
+ 'acm' => 0x02, 'abstract_control' => 0x02,
|
|
|
+ 0x02 => $cdc_pstn_protocols,
|
|
|
+ 'tcm' => 0x03, 'telephone_control' => 0x03,
|
|
|
+ 0x03 => $cdc_pstn_protocols,
|
|
|
+ 'mccm' => 0x04, 'multi_channel_control' => 0x04,
|
|
|
+ 0x04 => $cdc_pstn_protocols,
|
|
|
+ 'ccm' => 0x05, 'capi' => 0x05, 'capi_control' => 0x05,
|
|
|
+ 0x05 => $cdc_pstn_protocols,
|
|
|
+ 'ecm' => 0x06, 'ethernet_control' => 0x06,
|
|
|
+ 0x06 => $cdc_pstn_protocols,
|
|
|
+ 'atm' => 0x07, 'ancm' => 0x07, 'atm_networking_control' => 0x07,
|
|
|
+ 'whcm' => 0x08, 'wireless_handset_control' => 0x08,
|
|
|
+ 0x08 => $cdc_pstn_protocols,
|
|
|
+ 'device_management' => 0x09, 'mgmt' => 0x09, 'device' => 0x09,
|
|
|
+ 'mdlm' => 0x0a, 'mobile_direct_line' => 0x0a,
|
|
|
+ 'obex' => 0x0b,
|
|
|
+ 'eem' => 0x0c, 'ethernet' => 0x0c, 'ethernet_emulation' => 0x0c,
|
|
|
+ 0x0c => {
|
|
|
+ 'ethernet' => 0x07, 'eem' => 0x07
|
|
|
+ },
|
|
|
+ 'ncm' => 0x0d, 'net' => 0x0d, 'network_control' => 0x0d,
|
|
|
+ },
|
|
|
+
|
|
|
+ 'hid' => 0x03,
|
|
|
+
|
|
|
+ 'physical' => 0x05,
|
|
|
+ 'imaging' => 0x06, 'photo' => 0x06, 'idc' => 0x06,
|
|
|
+ 'printer' => 0x07,
|
|
|
+ 'mass_storage' => 0x08, 'storage' => 0x08, 'disk' => 0x08,
|
|
|
+ 'hub' => 0x09,
|
|
|
+ 'cdc_data' => 0x0a, 'data' => 0x0a,
|
|
|
+ 0x0a => {
|
|
|
+ 0 => {
|
|
|
+ 'ntb' => 0x01, 'network_transfer_block' => 0x01,
|
|
|
+
|
|
|
+ 'isdn_bri' => 0x30, 'isdn' => 0x30,
|
|
|
+ 'hdlc' => 0x31,
|
|
|
+ 'transparent' => 0x32,
|
|
|
+
|
|
|
+ 'q921_management' => 0x50, 'q921m' => 0x50,
|
|
|
+ 'q921_datalink' => 0x51, 'q921' => 0x51,
|
|
|
+ 'q921_tei_mux' => 0x52, 'q921tm' => 0x52,
|
|
|
+
|
|
|
+ 'v42bis' => 0x90,
|
|
|
+ 'euro_isdn' => 0x91, 'q931' => 0x91,
|
|
|
+ 'v120' => 0x92, 'isdn_v24' => 0x92,
|
|
|
+ 'capi' => 0x93,
|
|
|
+
|
|
|
+ 'host' => 0xfd,
|
|
|
+ 'external' => 0xfe,
|
|
|
+ 'vendor' => 0xff
|
|
|
+ },
|
|
|
+ },
|
|
|
+ 'smart_card' => 0x0b, 'smartcard' => 0x0b, 'scdc' => 0x0b,
|
|
|
+
|
|
|
+ 'content_security' => 0x0d, 'drm' => 0x0d, 'csdc' => 0x0d,
|
|
|
+ 'video' => 0x0e, 'vdc' => 0x0e,
|
|
|
+ 'personal_healthcare' => 0x0f, 'healthcare' => 0x0f, 'health' => 0x0f, 'phdc' => 0x0f,
|
|
|
+ 'audio_video' => 0x10, 'av' => 0x10, 'avdc' => 0x10,
|
|
|
+ 'billboard' => 0x11, 'bdc' => 0x11,
|
|
|
+ 'usb_c_bridge' => 0x12, 'usbc' => 0x12, 'usbcbdc' => 0x12,
|
|
|
+
|
|
|
+ 'diagnostic' => 0xdc,
|
|
|
+ 'wireless_controller' => 0xe0, 'wireless' => 0xe0,
|
|
|
+
|
|
|
+ 'miscellaneous' => 0xef, 'misc' => 0xef,
|
|
|
+
|
|
|
+ 'application_specific' => 0xfe, 'app_specific' => 0xfe, 'app' => 0xfe,
|
|
|
+ );
|
|
|
+
|
|
|
+my %packfmt = ( 1 => 'C', 2 => 'v', 4 => 'V', 8 => 'Q<' );
|
|
|
+
|
|
|
+my $utf16le = find_encoding('utf16le');
|
|
|
+
|
|
|
+sub atom($@) {
|
|
|
+ my $bytes = shift @_;
|
|
|
+ my @o = ();
|
|
|
+
|
|
|
+ foreach my $b (@_) {
|
|
|
+ my $t = ref $b;
|
|
|
+ if ($t eq 'SCALAR') {
|
|
|
+ # To be resolved later
|
|
|
+ push(@o, {'bytes' => $bytes, 'num' => $b});
|
|
|
+ } elsif ($t eq 'ARRAY') {
|
|
|
+ push (@o, atom($bytes, @$b));
|
|
|
+ } elsif ($t eq 'HASH') {
|
|
|
+ push(@o, $b);
|
|
|
+ } elsif ($t eq '') {
|
|
|
+ push(@o, pack($packfmt{$bytes}, $b));
|
|
|
+ }
|
|
|
+ }
|
|
|
+ return @o;
|
|
|
+}
|
|
|
+
|
|
|
+sub byte(@) {
|
|
|
+ return atom(1,@_);
|
|
|
+}
|
|
|
+sub word(@) {
|
|
|
+ return atom(2,@_);
|
|
|
+}
|
|
|
+sub dword(@) {
|
|
|
+ return atom(4,@_);
|
|
|
+}
|
|
|
+sub qword(@) {
|
|
|
+ return atom(8,@_);
|
|
|
+}
|
|
|
+
|
|
|
+# Generate endpoint identifiers
|
|
|
+sub ep_i($) {
|
|
|
+ my($n) = @_;
|
|
|
+ return byte($n|0x80);
|
|
|
+}
|
|
|
+sub ep_o($) {
|
|
|
+ my($n) = @_;
|
|
|
+ return byte($n|0x00);
|
|
|
+}
|
|
|
+
|
|
|
+sub toint($) {
|
|
|
+ my($i) = @_;
|
|
|
+ return ($i =~ /^0/) ? oct $i : ($i =~ /^[1-9]/) ? $i+0 : undef;
|
|
|
+}
|
|
|
+
|
|
|
+my $err = 0;
|
|
|
+
|
|
|
+# Generate class code triplets
|
|
|
+sub usb_class($;$$) {
|
|
|
+ my @cl = @_;
|
|
|
+ my $lvl = \%class_codes;
|
|
|
+ my $cd = '';
|
|
|
+
|
|
|
+ while (scalar(@cl) < 3) {
|
|
|
+ push(@cl, undef);
|
|
|
+ }
|
|
|
+ while (scalar(@cl)) {
|
|
|
+ my $cs = shift(@cl);
|
|
|
+ my $cc = defined($cs) ? toint($cs) : 0;
|
|
|
+ if (!defined($cc)) {
|
|
|
+ $cs = lc($cs);
|
|
|
+ $cs =~ s/\P{Alnum}+/_/g;
|
|
|
+
|
|
|
+ $cc = $lvl->{$cs} if (defined($lvl));
|
|
|
+ $cc = $class_all_levels{$cs} unless (defined($cc));
|
|
|
+ if (!defined($cc)) {
|
|
|
+ print STDERR "$0: unknown class code ", join('.', @_), "\n";
|
|
|
+ $err = 1;
|
|
|
+ $cc = 0;
|
|
|
+ }
|
|
|
+
|
|
|
+ $cd .= byte($cc);
|
|
|
+ $lvl = $lvl->{$cc};
|
|
|
+ }
|
|
|
+ }
|
|
|
+ return $cd;
|
|
|
+}
|
|
|
+
|
|
|
+sub datalen(@) {
|
|
|
+ my $l = 0;
|
|
|
+
|
|
|
+ foreach my $b (@_) {
|
|
|
+ my $t = ref $b;
|
|
|
+ if ($t eq 'HASH') {
|
|
|
+ $l += $b->{'bytes'};
|
|
|
+ } elsif ($t eq 'ARRAY') {
|
|
|
+ $l += datalen(@$b);
|
|
|
+ } elsif ($t eq 'SCALAR') {
|
|
|
+ $l += length($$b);
|
|
|
+ } elsif ($t eq '') {
|
|
|
+ $l += length($b);
|
|
|
+ } else {
|
|
|
+ die;
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ return $l;
|
|
|
+}
|
|
|
+
|
|
|
+sub makedata(@) {
|
|
|
+ my $o = '';
|
|
|
+
|
|
|
+ foreach my $b (@_) {
|
|
|
+ my $t = ref $b;
|
|
|
+ if ($t eq 'HASH') {
|
|
|
+ if (defined($b->{'num'})) {
|
|
|
+ $o .= pack($packfmt{$b->{'bytes'}}, ${$b->{'num'}});
|
|
|
+ } elsif (defined($b->{'data'})) {
|
|
|
+ my $raw;
|
|
|
+ $b->{'offs'} = length($o);
|
|
|
+ $raw = makedata($b->{'data'});
|
|
|
+ $b->{'raw'} = $raw;
|
|
|
+ $b->{'bytes'} = length($raw);
|
|
|
+ $o .= $raw;
|
|
|
+ } else {
|
|
|
+ die;
|
|
|
+ }
|
|
|
+ } elsif ($t eq 'ARRAY') {
|
|
|
+ $o .= makedata(@$b);
|
|
|
+ } elsif ($t eq 'SCALAR') {
|
|
|
+ $o .= makedata($$b);
|
|
|
+ } elsif ($t eq '') {
|
|
|
+ $o .= $b;
|
|
|
+ } else {
|
|
|
+ die;
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ return $o;
|
|
|
+}
|
|
|
+
|
|
|
+# USB descriptor set
|
|
|
+my $u_self = { 'children' => \(my $children = 0), clist => [] };
|
|
|
+sub usb_dset(&) {
|
|
|
+ my($contents) = @_;
|
|
|
+ my $parent = $u_self;
|
|
|
+ my $children = 0;
|
|
|
+ my $index = ++${$u_self->{'children'}};
|
|
|
+
|
|
|
+ my $ds = { 'type' => 'dset',
|
|
|
+ 'parent' => $parent,
|
|
|
+ 'data' => undef,
|
|
|
+ 'bytes' => undef,
|
|
|
+ 'raw' => undef,
|
|
|
+ 'children' => \$children,
|
|
|
+ 'index' => \$index,
|
|
|
+ 'offs' => undef,
|
|
|
+ 'clist' => [] };
|
|
|
+ $u_self = $ds;
|
|
|
+ push(@{$parent->{'clist'}}, $ds);
|
|
|
+ my @data = $contents->($ds, $parent);
|
|
|
+ $ds->{'data'} = \@data;
|
|
|
+ $ds->{'bytes'} = datalen(@data);
|
|
|
+ $u_self = $parent;
|
|
|
+ return $ds;
|
|
|
+}
|
|
|
+sub usb_totallen(;$) {
|
|
|
+ my($r) = @_;
|
|
|
+ $r = $u_self unless(defined($r));
|
|
|
+
|
|
|
+ return word(\$r->{'bytes'});
|
|
|
+}
|
|
|
+sub usb_index(;$) {
|
|
|
+ my($r) = @_;
|
|
|
+ $r = $u_self unless(defined($r));
|
|
|
+
|
|
|
+ return byte($r->{'index'});
|
|
|
+}
|
|
|
+sub usb_peers(;$) {
|
|
|
+ my($r) = @_;
|
|
|
+ $r = $u_self unless(defined($r));
|
|
|
+
|
|
|
+ return byte($r->{'parent'}{'children'});
|
|
|
+}
|
|
|
+sub usb_children(;$) {
|
|
|
+ my($r) = @_;
|
|
|
+ $r = $u_self unless(defined($r));
|
|
|
+
|
|
|
+ return byte($r->{'children'});
|
|
|
+}
|
|
|
+
|
|
|
+# USB descriptor
|
|
|
+sub usb_desc($@) {
|
|
|
+ my($typestr, @data) = @_;
|
|
|
+
|
|
|
+ my($type,$subtype) = split(/\./, $typestr, 2);
|
|
|
+
|
|
|
+ my $tn;
|
|
|
+ my $sn;
|
|
|
+ my $hdr;
|
|
|
+ my $dlen = datalen(@data);
|
|
|
+
|
|
|
+ $tn = toint($type);
|
|
|
+ $tn = $DT{lc($type)} unless (defined($tn));
|
|
|
+ die "$0: unknown descriptor type: $typestr\n" unless (defined($tn));
|
|
|
+
|
|
|
+ if (defined($subtype)) {
|
|
|
+ $sn = toint($subtype);
|
|
|
+ $sn = $DS{$tn}->{$subtype} unless (defined($sn));
|
|
|
+ die "$0: unknown descriptor type: $typestr\n" unless (defined($sn));
|
|
|
+
|
|
|
+ $dlen += 3;
|
|
|
+ $hdr = pack("CCC", $dlen, $type, $subtype);
|
|
|
+ } else {
|
|
|
+ $dlen += 2;
|
|
|
+ $hdr = pack("CC", $dlen, $type);
|
|
|
+ }
|
|
|
+ return { 'type' => 'descriptor',
|
|
|
+ 'data' => [$hdr, @data],
|
|
|
+ 'bytes' => $dlen };
|
|
|
+}
|
|
|
+
|
|
|
+# Device top level
|
|
|
+my $device_dset;
|
|
|
+sub usb_device(&) {
|
|
|
+ my($contents) = @_;
|
|
|
+ $device_dset = usb_dset(\&$contents);
|
|
|
+}
|
|
|
+
|
|
|
+my @langlist;
|
|
|
+my %lang;
|
|
|
+my $stringdata;
|
|
|
+my %stringoffs; # Pointer into stringdata
|
|
|
+my %strdesci = ('' => 0); # String descriptor index (all strings identical)
|
|
|
+my @strdescs = (''); # Descriptor 0 means no string
|
|
|
+my $nstrdesc = 1;
|
|
|
+
|
|
|
+# Register a string into the string table and return a descriptor index byte.
|
|
|
+# Input should be a hash.
|
|
|
+sub usb_string(%) {
|
|
|
+ my(%strh) = @_;
|
|
|
+
|
|
|
+ my $descval = '';
|
|
|
+ my @txts = (undef) x scalar(@langlist);
|
|
|
+
|
|
|
+ my $found = $strh{''} ne ''; # Default string
|
|
|
+
|
|
|
+ foreach my $l (keys(%strh)) {
|
|
|
+ my $co = langid($l);
|
|
|
+ next unless (defined($co));
|
|
|
+ $txts[$lang{$co}] = $strh{$l};
|
|
|
+ $found += $strh{$l} ne '';
|
|
|
+ }
|
|
|
+
|
|
|
+ return pack("C", 0) unless ($found);
|
|
|
+
|
|
|
+ for (my $i = 0; $i < scalar(@langlist); $i++) {
|
|
|
+ my $co = $langlist[$i];
|
|
|
+ my $txt = $txts[$i];
|
|
|
+ $txt = $strh{''} unless defined($txt);
|
|
|
+
|
|
|
+ my $utf16str = $utf16le->encode($txt, Encode::FB_WARN);
|
|
|
+ unless (defined($stringoffs{$utf16str})) {
|
|
|
+ $stringoffs{$utf16str} = length($stringdata);
|
|
|
+ $stringdata .= pack("CC", length($utf16str)+2, $DT{string});
|
|
|
+ $stringdata .= $utf16str;
|
|
|
+ }
|
|
|
+
|
|
|
+ $descval .= pack("vv", $co, $stringoffs{$utf16str});
|
|
|
+ }
|
|
|
+
|
|
|
+ my $descindex = $strdesci{$descval};
|
|
|
+ unless (defined($descindex)) {
|
|
|
+ $descindex = $strdesci{$descval} = scalar @strdescs;
|
|
|
+ push(@strdescs, $descval);
|
|
|
+ }
|
|
|
+
|
|
|
+ return pack("C", $descindex);
|
|
|
+}
|
|
|
+
|
|
|
+sub usb_languages(@) {
|
|
|
+ my @langs = @_;
|
|
|
+
|
|
|
+ %lang = ();
|
|
|
+ @langlist = ();
|
|
|
+ foreach my $l (@langs) {
|
|
|
+ my $co = langid($l);
|
|
|
+ if (defined($co) && !defined($lang{$co})) {
|
|
|
+ $lang{$co} = scalar(@langlist);
|
|
|
+ push(@langlist, $co);
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ if (!scalar(@langlist)) {
|
|
|
+ $stringdata = '';
|
|
|
+ } else {
|
|
|
+ $stringdata = pack("CCv*", scalar(@langlist)*2 + 2,
|
|
|
+ $DT{string}, @langlist);
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+my $descriptor_data;
|
|
|
+my @descriptor_ptrs;
|
|
|
+sub generate_data()
|
|
|
+{
|
|
|
+ my $data = '';
|
|
|
+
|
|
|
+ $data = makedata($device_dset);
|
|
|
+ my @ptrs = {'type' => $DT{device}, 'offs' => 0,
|
|
|
+ 'len' => unpack("C", substr($data, 0, 1))};
|
|
|
+
|
|
|
+ foreach my $dc (@{$device_dset->{'clist'}}) {
|
|
|
+ push(@ptrs, {'type' => unpack("C", substr($dc->{'raw'},
|
|
|
+ $dc->{'offs'}+1, 1)),
|
|
|
+ 'dindex' => $dc->{'index'},
|
|
|
+ 'offs' => $dc->{'offs'},
|
|
|
+ 'len' => $dc->{'bytes'}});
|
|
|
+ }
|
|
|
+
|
|
|
+ my $string_offs = length($data);
|
|
|
+
|
|
|
+ push(@ptrs, {'type' => $DT{string}, 'dindex' => 0,
|
|
|
+ 'offs' => $string_offs,
|
|
|
+ 'len' => unpack("C", substr($stringdata, 0, 1))});
|
|
|
+
|
|
|
+ for (my $i = 1; $i < scalar(@strdescs); $i++) {
|
|
|
+ my @sds = unpack("v*", $strdescs[$i]);
|
|
|
+ while (scalar @sds >= 2) {
|
|
|
+ my $co = shift(@sds);
|
|
|
+ my $offs = shift(@sds);
|
|
|
+
|
|
|
+ push(@ptrs, {'type' => $DT{string}, 'dindex' => $i,
|
|
|
+ 'windex' => $co,
|
|
|
+ 'offs' => $string_offs + $offs,
|
|
|
+ 'len' =>
|
|
|
+ unpack("C", substr($stringdata, $offs, 1))});
|
|
|
+ }
|
|
|
+ }
|
|
|
+ $data .= $stringdata;
|
|
|
+
|
|
|
+ $descriptor_data = $data;
|
|
|
+ @descriptor_ptrs = @ptrs;
|
|
|
+
|
|
|
+ return $descriptor_data;
|
|
|
+}
|
|
|
+my($mode, $infile, $outfile) = @ARGV;
|
|
|
+
|
|
|
+unless (defined(do File::Spec->rel2abs($infile))) {
|
|
|
+ die "$0: $infile: $!\n"
|
|
|
+}
|
|
|
+
|
|
|
+generate_data();
|
|
|
+
|
|
|
+exit ($err) if ($err);
|
|
|
+
|
|
|
+open(my $out, '>', $outfile)
|
|
|
+ or die "$0: $outfile: $!\n";
|
|
|
+print $out $descriptor_data;
|
|
|
+close($out);
|
|
|
+
|
|
|
+if ($err) {
|
|
|
+ remove($outfile);
|
|
|
+}
|
|
|
+exit($err);
|
H. Peter Anvin