#!/usr/bin/perl -w # xmakesis v1.0 # Psion Epoc32 .SIS file creator # (c) 2000 Andrew de Quincey, adq@tardis.ed.ac.uk # Released under the Gnu Public License (See COPYING for details) # # Some bugfixes and SymbianOS 6.0 / unicode port by Rudolf Koenig, KI AG # (c) 2001 Knowledge Intelligence AG, rko @ ki-ag.de use strict; use Compress::Zlib; sub MakeSrcName($$); sub doData($$); sub readFile($$$); sub ULength($); sub write_sis_file($); # these are the known language name -> code mappings # Following are the documented ones in the Crystal DeveloperLibrary # The EpocR5 documented ones are a subset of these. my %language_tokens = ( 'EN', 1, 'FR', 2, 'GE', 3, 'SP', 4, 'IT', 5, 'SW', 6, 'DA', 7, 'NO', 8, 'FI', 9, 'AM', 0xA, 'SF', 0xB, 'SG', 0xC, 'PO', 0xD, 'TU', 0xE, 'IC', 0xF, 'RU', 0x10, 'HU', 0x11, 'DU', 0x12, 'BL', 0x13, 'AU', 0x14, 'BF', 0x15, 'IF', 0x18, 'CS', 0x19, 'PL', 0x1b, 'TC', 0x1d, 'ZH', 0x1f, 'TH', 0x21, 'AS', 0x16, 'NZ', 0x17, 'SK', 0x1a, 'SL', 0x1c, 'HK', 0x1e, 'JA', 0x20 ); # header arguments -> code mapping my %header_args = ( 'IU', 1, 'ID', 2, 'NC', 8, 'SH', 16, 'TYPE=SA', 0, 'TYPE=SY', 65536, 'TYPE=S0', 131072, ); my $initial_header_args = 0; my $total_file_size = 0; my $fakedir = "C:\\TMP\\MKS1\\"; # global variables we will be using # list of numbers identifying languages # # One integer per language # my $seen_languages = 0; my @languages = (); # Hash of compressed files, the key is the filename. my %file_data; my %file_origsize; my $docompress = 0; # hash containing header parts # # "uid": UID of the package # "major": Major version # "minor": Minor version # "variant": Variant # "args": Arguments # "names": Reference to list of names # my $seen_installHeader = 0; my %installHeader = (); # list of references to hashes as follows: # # "src": Source file # (a string for non language dependent files # a list for language dependent files) # "srcname": Fake source filename to be in sync with the original makesis # "dest": Destination file # "langdep": Language dependent flag # "type": File type # "misc": Misc data # "depfiles": Language dependent files # my @files = (); # list of references to hashes as follows: # # "uid": UID # "major": Major # "minor": Minor # "variant": Variant # "names": List of names, one per language # my @dependencies = (); # Current line number in text file # my $lineNum = 0; # Language dependency things # # langDep_type is either 1(FILE) or 2(PACKAGE) # langDep_tmp is the language dependent files concerned # in_langDep indicates whether we're in a language dependent bit or not # langDep_count is the number of language dependent files # my $langDep_type = 0; my @langDep_tmp = (); my $in_langDep = 0; my $langDep_count = 0; # Number of bytes which will be needed for all the strings # my $strings_size = 0; # The following constats will be changed for Unicode builds my $uid2 = 0x1000006d; my $const1 = 0; my $const2 = 0x64; # CRC table # my @crcTable=(0x0000, 0x1021, 0x2042, 0x3063, 0x4084, 0x50a5, 0x60c6, 0x70e7, 0x8108, 0x9129, 0xa14a, 0xb16b, 0xc18c, 0xd1ad, 0xe1ce, 0xf1ef, 0x1231, 0x0210, 0x3273, 0x2252, 0x52b5, 0x4294, 0x72f7, 0x62d6, 0x9339, 0x8318, 0xb37b, 0xa35a, 0xd3bd, 0xc39c, 0xf3ff, 0xe3de, 0x2462, 0x3443, 0x0420, 0x1401, 0x64e6, 0x74c7, 0x44a4, 0x5485, 0xa56a, 0xb54b, 0x8528, 0x9509, 0xe5ee, 0xf5cf, 0xc5ac, 0xd58d, 0x3653, 0x2672, 0x1611, 0x0630, 0x76d7, 0x66f6, 0x5695, 0x46b4, 0xb75b, 0xa77a, 0x9719, 0x8738, 0xf7df, 0xe7fe, 0xd79d, 0xc7bc, 0x48c4, 0x58e5, 0x6886, 0x78a7, 0x0840, 0x1861, 0x2802, 0x3823, 0xc9cc, 0xd9ed, 0xe98e, 0xf9af, 0x8948, 0x9969, 0xa90a, 0xb92b, 0x5af5, 0x4ad4, 0x7ab7, 0x6a96, 0x1a71, 0x0a50, 0x3a33, 0x2a12, 0xdbfd, 0xcbdc, 0xfbbf, 0xeb9e, 0x9b79, 0x8b58, 0xbb3b, 0xab1a, 0x6ca6, 0x7c87, 0x4ce4, 0x5cc5, 0x2c22, 0x3c03, 0x0c60, 0x1c41, 0xedae, 0xfd8f, 0xcdec, 0xddcd, 0xad2a, 0xbd0b, 0x8d68, 0x9d49, 0x7e97, 0x6eb6, 0x5ed5, 0x4ef4, 0x3e13, 0x2e32, 0x1e51, 0x0e70, 0xff9f, 0xefbe, 0xdfdd, 0xcffc, 0xbf1b, 0xaf3a, 0x9f59, 0x8f78, 0x9188, 0x81a9, 0xb1ca, 0xa1eb, 0xd10c, 0xc12d, 0xf14e, 0xe16f, 0x1080, 0x00a1, 0x30c2, 0x20e3, 0x5004, 0x4025, 0x7046, 0x6067, 0x83b9, 0x9398, 0xa3fb, 0xb3da, 0xc33d, 0xd31c, 0xe37f, 0xf35e, 0x02b1, 0x1290, 0x22f3, 0x32d2, 0x4235, 0x5214, 0x6277, 0x7256, 0xb5ea, 0xa5cb, 0x95a8, 0x8589, 0xf56e, 0xe54f, 0xd52c, 0xc50d, 0x34e2, 0x24c3, 0x14a0, 0x0481, 0x7466, 0x6447, 0x5424, 0x4405, 0xa7db, 0xb7fa, 0x8799, 0x97b8, 0xe75f, 0xf77e, 0xc71d, 0xd73c, 0x26d3, 0x36f2, 0x0691, 0x16b0, 0x6657, 0x7676, 0x4615, 0x5634, 0xd94c, 0xc96d, 0xf90e, 0xe92f, 0x99c8, 0x89e9, 0xb98a, 0xa9ab, 0x5844, 0x4865, 0x7806, 0x6827, 0x18c0, 0x08e1, 0x3882, 0x28a3, 0xcb7d, 0xdb5c, 0xeb3f, 0xfb1e, 0x8bf9, 0x9bd8, 0xabbb, 0xbb9a, 0x4a75, 0x5a54, 0x6a37, 0x7a16, 0x0af1, 0x1ad0, 0x2ab3, 0x3a92, 0xfd2e, 0xed0f, 0xdd6c, 0xcd4d, 0xbdaa, 0xad8b, 0x9de8, 0x8dc9, 0x7c26, 0x6c07, 0x5c64, 0x4c45, 0x3ca2, 0x2c83, 0x1ce0, 0x0cc1, 0xef1f, 0xff3e, 0xcf5d, 0xdf7c, 0xaf9b, 0xbfba, 0x8fd9, 0x9ff8, 0x6e17, 0x7e36, 0x4e55, 0x5e74, 0x2e93, 0x3eb2, 0x0ed1, 0x1ef0 ); my $ubuild = 0; # Unicode build # check args if(@ARGV > 1 && ($ARGV[0] =~ m/^-u$/ || $ARGV[0] =~ m/^-unicode$/)) { $ubuild = 1; shift @ARGV; } die("Syntax: makesis [-unicode] []\n") if (((@ARGV) <1) || (@ARGV > 2)); my $pkgFile = $ARGV[0]; die ("$pkgFile is not a .pkg file!\n") if ($pkgFile !~ /\.pkg$/i); my $sisFile; if (@ARGV == 2) { $sisFile = $ARGV[1]; die ("$sisFile is not a .sis file!\n") if ($sisFile !~ /\.sis$/i); } else { $sisFile = $pkgFile; $sisFile =~ s/pkg$/sis/i; } # Some unicode dependent variables if($ubuild) { $uid2 = 0x10003a12; $const1 = 0x21; $const2 = 0xc8; $initial_header_args += $header_args{IU}; $docompress = 1; } # process the pkg file read_pkg_file($pkgFile); # output the sis file write_sis_file($sisFile); # tada! exit; # Lenght (either unicode-2byte or latin1) sub ULength($) { my $str = shift @_; my $l = length($str); if($ubuild) { return 2*$l; } else { return $l; } } sub MakeSrcName($$) { my $in = shift; my $type = shift; if($type == 4) { $in = ""; } else { if($in =~ m,[/\\],) { $in =~ s,.*[/\\],$fakedir,; } else { $in = "$fakedir$in"; } } return $in; } # outputs the binary SIS file # # @param $sisFile SIS file to output to # sub write_sis_file($) { my ($sisFile) = @_; my ($off_languages, $off_files, $off_dependencies, $off_strings, $off_data, $tmp, $lang, $cur_string, $cur_data, $src, $srcs, $file, $dep, $name, $x, $off_strings_data); # work out offsets to various data tables my ($nf, $nl, $nd) = (scalar(@files), scalar(@languages), scalar(@dependencies)); if($ubuild) { $off_languages = 0x64; $off_files = $off_languages + $nl*2; $off_dependencies = $off_files + $nf*48 + ($langDep_count - $langDep_count/$nl)*12; $off_strings = $off_dependencies + $nd*12 + $nd*$nl*8; $off_strings_data = $off_strings + $nl*8; $off_data = $off_strings_data + $strings_size; } else { $off_languages = 0x44; $off_files = $off_languages + $nl*2; $off_dependencies = $off_files + $nf*36 + ($langDep_count - $langDep_count/$nl)*8; $off_strings = $off_dependencies + $nd*12 + $nd*$nl*8; $off_strings_data = $off_strings + $nl*8; $off_data = $off_strings_data + $strings_size; } # location for the next string & data chunk $cur_string = $off_strings_data; $cur_data = $off_data; # open output file open SISFILE, ">$sisFile"; binmode(SISFILE); # OK, output the file header print SISFILE pack("VVVVvvvvVVVVvvVVVVVV", $installHeader{uid}, $uid2, 0x10000419, doUidCrc($installHeader{uid}, $uid2, 0x10000419), 0, $nl, $nf, $nd, 0, $const1, $const2, $installHeader{args}, $installHeader{major}, $installHeader{minor}, $installHeader{variant}, $off_languages, $off_files, $off_dependencies, 0, $off_strings); if($ubuild) { print SISFILE pack("VVVVVVVV", 0, $off_strings, 0, $total_file_size, 0, 0, 0, 0); } # output the list of languages foreach $lang (@languages) { print SISFILE pack("v", $lang); } # Reverse the order my @x; while (@files) { push(@x, pop(@files)); } @files = @x; # output the files foreach $file (@files) { # output the first file header print SISFILE pack("VVV", $file->{langdep}, $file->{type}, $file->{misc}); # OK, do the filenames # language depdendent files need special handling my $ft = $file->{type}; if (!$file->{langdep}) { my $sf = $file->{src}; my $df = $file->{dest}; my $sn = $file->{srcname}; my $fn = $df ? $df : $sf; # do source filename print SISFILE pack("VV", ULength($sn), $cur_string); doString($cur_string, $sn); $cur_string += ULength($sn); # if it's a package file, it has no destination filename if ($ft == 2) { print SISFILE pack("VV", 0, 0); } else { # oh ho! Its a normal file.. so it has a destination filename print SISFILE pack("VV", ULength($df), $cur_string); doString($cur_string, $df); $cur_string += ULength($df); } # output file data print SISFILE pack("VV", length($file_data{$fn}), $cur_data); if($ubuild) { print SISFILE pack("VVV", $file_origsize{$fn}, 0, $cur_string); } doData($cur_data, $fn); $cur_data += length($file_data{$fn}), } else { # i.e. a language dependent file $srcs = $file->{srcname}; my $sf = @$srcs[0]; my $df = $file->{dest}; # get the list of source files # do the source filename (just use the last language dependent file) print SISFILE pack("VV", ULength($sf), $cur_string); doString($cur_string, $sf); $cur_string += ULength($sf); # the destination filename print SISFILE pack("VV", ULength($df), $cur_string); doString($cur_string, $df); $cur_string += ULength($df); # output files data $srcs = $file->{src}; foreach $src (@$srcs) { print SISFILE pack("V", length($file_data{$src})); } foreach $src (@$srcs) { print SISFILE pack("V", $cur_data); doData($cur_data, $src); $cur_data += length($file_data{$src}); } if($ubuild) { foreach $src (@$srcs) { print SISFILE pack("V", $file_origsize{$src}); } print SISFILE pack("V", 0); print SISFILE pack("V", $cur_string); } } } # output the dependencies foreach $dep (@dependencies) { # output depdendency header print SISFILE pack("VvvV", $dep->{uid}, $dep->{major}, $dep->{minor}, $dep->{variant}); # output the names $x = $dep->{names}; foreach $name (@$x) { print SISFILE pack("V", ULength($name)); } foreach $name (@$x) { print SISFILE pack("V", $cur_string); doString($cur_string, $name); $cur_string += ULength($name); } } # output the header strings $x = $installHeader{names}; foreach $name (@$x) { print SISFILE pack("V", ULength($name)); } foreach $name (@$x) { print SISFILE pack("V", $cur_string); doString($cur_string, $name); $cur_string += ULength($name); } # output the file CRC seek(SISFILE, 16, 0); print SISFILE pack("v", doSisFileCrc($sisFile)); # close output file close SISFILE; } # Writes a string to a certain location in the file # # @param offset Offset to seek to # @param str String to write # sub doString { my ($offset, $str) = @_; my ($cur_offset); # remember where we are $cur_offset = tell(SISFILE); # OK, seek to offset & write string seek(SISFILE, $offset, 0); if($ubuild) { for(my $i = 0; $i < length($str); $i++) { print SISFILE pack("v", ord(substr($str, $i, 1))); } } else { print SISFILE $str; } seek(SISFILE, $cur_offset, 0); } # Copies a data file into a certain location in the .SIS file # # @param offset Offset to seek to # @param filename Filename to copy from # sub doData($$) { my ($offset, $filename) = @_; my ($cur_offset); # remember where we are $cur_offset = tell(SISFILE); # OK, seek to offset and copy data into the SIS file seek(SISFILE, $offset, 0); syswrite(SISFILE, $file_data{$filename}); # go back to where we were seek(SISFILE, $cur_offset, 0); } # reads in the pkg file and adds its data to the global variables # # @param $pkgFile Package file # sub read_pkg_file { my ($pkgFile) = @_; my ($line); # open PKG file open PKGFILE, "<$pkgFile" or die ("Cannot open $pkgFile\n"); binmode(PKGFILE); # parse the PKG file $lineNum = 0; while($line = ) { # splat CRs/LFs $line =~ tr/\r\n//ds; # next line $lineNum++; # skip whitespace-only & comments lines next if ($line =~ /^\s*$/); next if ($line =~ /^\s*;/); # is it the languages definition line? if ($line =~ /^\s*&/) { # have we already seen this? if so=> ERROR! die("$pkgFile($lineNum): Misplaced language definition line\n") if ($seen_languages); # process the language lines handle_languages_line($line); $seen_languages = 1; next; } # is it the installation header line elsif ($line =~ /^\s*\#\{/) { # have we already seen this? if so=> ERROR! die("$pkgFile($lineNum): Misplaced installation header line\n") if ($seen_installHeader); # add in the english language as a default if we've not seen a language line handle_language_line("&EN") if (!$seen_languages); $seen_languages = 1; # process the header lne handle_installHeader_line($line); $seen_installHeader = 1; next; } # we MUST have got the header & language lines now die("$pkgFile($lineNum): Missing language or install header line\n") if ((!$seen_languages) || (!$seen_installHeader)); # a file to install if ($line =~ /^\s*\"/) { if (!$in_langDep) { handle_file_line($line); next; } else { handle_langDep_file_line($line); next; } } elsif ($line =~ /^\s*\@/) { if (!$in_langDep) { handle_package_line($line); next; } else { handle_langDep_package_line($line); next; } } elsif (($line =~ /^\s*\(/) && (!$in_langDep)) { handle_dependency_line($line); next; } elsif (($line =~ /^\s*\{/) && (!$in_langDep)) { handle_langDep_start($line); next; } elsif (($line =~ /^\s*\}/) && ($in_langDep)) { if ($langDep_type == 1) { handle_langDep_file_end($line); } elsif ($langDep_type == 2) { handle_langDep_package_end($line); } else { die("$pkgFile($lineNum): Invalid language depdendent section\n"); } next; } # if we get to here, we've got an unknown line in the file die("$pkgFile($lineNum): Unknown line\n"); } # close input file close PKGFILE; } # Handle the language dependency start line # # @param $line Line to process # sub handle_langDep_start { my ($line) = @_; # set things $langDep_type = 0; @langDep_tmp = (); $in_langDep = 1; } # Handle the language line # # @param $line Line to process # sub handle_languages_line { my ($line) = @_; my (@langs, $curLang, $lang); # split the line up into language tokens & remove any guff $line =~ tr/\t //ds; die("$pkgFile($lineNum): Invalid language line\n") if (!($line =~ /^\&([a-zA-Z,]*)/)); @langs = split(",", $1); # get the language IDs foreach $curLang (@langs) { $lang = $language_tokens{$curLang}; die("$pkgFile($lineNum): Unknown language token: $curLang\n") if (!defined($lang)); if($ubuild) { unshift(@languages, $lang); } else { push(@languages, $lang); } } # seen language line $seen_languages = 1; } # Handle the install header lines # # @param $line Line to process # sub handle_installHeader_line { my ($line) = @_; my ($names, $rest, @names, $inLangs, $inQuotes, $flags, $token, @tokens, $bitmap); # OK, chop up the line die("$pkgFile($lineNum): Invalid installation header\n") if (!($line =~ /^\#\{\s*((\"[^\"]*\",?\s*)*)\s*\}\s*,(.*)$/)); $names = $1; $rest = $3; # extract the names while($names =~ /\s*\"([^\"]*)\"\s*,?\s*/g) { push(@names, $1); $strings_size += ULength($1); } # did we get the correct number of names? die("Wrong number of names for languages\n") if (scalar(@names) != scalar(@languages)); $installHeader{names} = \@names; # OK, chop the line up... removing crap, and skipping over the first comma $rest =~ tr/ \t()//ds; @tokens = split(",", $rest); # if we don't have at least 4 tokens, there's a problem die("$pkgFile($lineNum): Invalid installation header\n") if (scalar(@tokens) < 3); # OK, extract stuff $installHeader{uid} = num(shift(@tokens)); $installHeader{major} = num(shift(@tokens)); $installHeader{minor} = num(shift(@tokens)); # set these to defaults $installHeader{variant} = 0; $installHeader{args} = 0; # do we have a variant? return if (!scalar(@tokens)); if ($tokens[0] =~ /^[0-9]*$/) { $installHeader{variant} = num(shift(@tokens)); } else { $installHeader{variant} = 0; } # do we have args? $flags = 0; $flags = $initial_header_args; foreach $token (@tokens) { $bitmap = $header_args{$token}; die("$pkgFile($lineNum): Invalid installation header\n") if (!defined($bitmap)); $flags += $bitmap; $docompress = 0 if($token eq "NC"); } $installHeader{args} = $flags; } sub readFile($$$) { my $src = shift; my $dest = shift; my $ft = shift; my $fname = $src; $fname = $dest if($dest); my ($input, $buf); $input = ""; open(FH, $src) || die("Cannot open $src"); binmode(FH); while(sysread(FH, $buf, 1024)) { $input .= $buf; } close(FH); if($ft == 1 && $ubuild) { # Unicode the string my $output = ""; for(my $i = 0; $i < length($input); $i++) { $output .= pack("v", ord(substr($input, $i, 1))); } $input = $output; } if($docompress) { if($input) { $file_data{$fname} = compress($input); } else { if($ft != 4) { # The following is 0 uncompressed. Our library is returning # undef when compressing 0 length $file_data{$fname} = pack("NN", 0x789c0300, 1); } else { $file_data{$fname} = ""; } } } else { $file_data{$fname} = $input; } $file_origsize{$fname} = length($input); $total_file_size += length($input); } # Handle the file line # # @param $line Line to process # sub handle_file_line { my ($line) = @_; my (%file, @args, $arg, $bitmap, $flags, $rawargs, $src, $dest, $type, $misc); # get the three parts of the line (SRC,DEST,ARGS) die("$pkgFile($lineNum): Invalid file line\n") if (!($line =~ /^\s*\"([^\"]*)\"\s*-\s*\"([^\"]*)\",?(.*)$/)); $src = $1; $dest = $2; # do args $rawargs = $3; $rawargs =~ s/\s//g; @args = split(",", $rawargs); # defaults $type = 0; $misc = 0; # rest of args depend on firt argument # BTW: Type 2 = package file # if (@args) { if ($args[0] =~ /FT/) { # Text file, not installed, just displayed $type = 1; $misc = 0; $misc = 0 if ($args[1] =~ /TC/); $misc = 1 if ($args[1] =~ /TS/); $misc = 2 if ($args[1] =~ /TA/); } elsif ($args[0] =~ /FR/) { # exe file, run on install/deinstall $type = 3; $misc = 0; $misc = 0 if ($args[1] =~ /RI/); $misc = 1 if ($args[1] =~ /RR/); $misc = 2 if ($args[1] =~ /RB/); } elsif ($args[0] =~ /FN/) { # isn't actually there yet $type = 4; $misc = 0; } elsif ($args[0] =~ /FF/) { # normal file $type = 0; $misc = 0; } else { die("$pkgFile($lineNum): Invalid file line\n"); } } readFile($src, $dest, $type); # if the file is of type 4, it isn't there yet if ($type != 4) { die("$pkgFile($lineNum): File $1 not present\n") if (! -f $src); } my $srcname = MakeSrcName($src, $type); $strings_size += ULength($srcname); $strings_size += ULength($dest); # make up new structure %file = ( "src", $src, "srcname", $srcname, "dest", $dest, "langdep", 0, "type", $type, "misc", $misc ); # add it to the list of files push(@files, \%file); } # Handle the file language dependent line # # @param $line Line to process # sub handle_langDep_file_line { my ($line) = @_; my ($file, $uid); # set the type of language dependency $langDep_type = 1; # parse line die("$pkgFile($lineNum): Invalid file line\n") if (!($line =~ /^\s*\"([^\"]*)\"/)); $file = $1; # don't count the size of this string readFile($file, "", 0); # add it to the list of language dependent thingies for updating later if($ubuild) { unshift(@langDep_tmp, $file); } else { push(@langDep_tmp, $file); } $langDep_count++; } # Handle end of language dependent files # # @param $line Line to process # sub handle_langDep_file_end { my ($line) = @_; my (%file, @args, $arg, $bitmap, $flags, $rawargs, $src, $dest, $type, $misc); # get the two parts of the line (SRC,DEST,ARGS) die("$pkgFile($lineNum): Invalid file line\n") if (!($line =~ /^\s*\}\s*-\s*\"([^\"]*)\",?(.*)$/)); $dest = $1; # do args $rawargs = $2; $rawargs =~ s/\s//g; @args = split(",", $rawargs); # defaults $type = 0; $misc = 0; # rest of args depend on first argument # BTW: Type 2 = package file # if (@args) { if ($args[0] =~ /FT/) { # Text file, not installed, just displayed $type = 1; $misc = 0; $misc = 0 if ($args[1] =~ /TC/); $misc = 1 if ($args[1] =~ /TS/); $misc = 2 if ($args[1] =~ /TA/); } elsif ($args[0] =~ /FR/) { # exe file, run on install/deinstall $type = 3; $misc = 0; $misc = 0 if ($args[1] =~ /RI/); $misc = 1 if ($args[1] =~ /RR/); $misc = 2 if ($args[1] =~ /RB/); } elsif ($args[0] =~ /FN/) { # isn't actually there yet $type = 4; $misc = 0; } elsif ($args[0] =~ /FF/) { # normal file $type = 0; $misc = 0; } else { # error! die("$pkgFile($lineNum): Invalid file line\n"); } } my @langDep_tmpname; foreach my $x (@langDep_tmp) { push(@langDep_tmpname, MakeSrcName($x, $type)); } # add in the string length of the last source file $strings_size += ULength($langDep_tmpname[0]); $strings_size += ULength($dest); # make up new structure %file = ( "src", \@langDep_tmp, "srcname", \@langDep_tmpname, "dest", $dest, "langdep", 1, "type", $type, "misc", $misc ); # add it in push(@files, \%file); } # Handle the package line # # @param $line Line to process # sub handle_package_line { my ($line) = @_; my ($file, $uid, %file); # parse line die("$pkgFile($lineNum): Invalid package line\n") if (!($line =~ /^\s*\@\s*\"([^\"]*)\"\s*,\s*\(\s*([0-9xa-fA-F]*)\s*\)/)); $file = $1; $uid = num($2); # check the package file die("$pkgFile($lineNum): Not a .SIS file $file\n") if ($file !~ /\.sis$/i); die("$pkgFile($lineNum): File $file not present\n") if (! -f $file); if(!-f $file) { die("Cannot open $file\n"); } # make up new structure my $srcname = MakeSrcName($file, 2); $strings_size += ULength($srcname); %file = ( "src", $file, "srcname", $srcname, "dest", "", "langdep", 0, "type", 2, "misc", $uid ); readFile($file, "", 2); # add it to the list of files push(@files, \%file); } # Handle the package language dependent line # # @param $line Line to process # sub handle_langDep_package_line { my ($line) = @_; my ($file, $uid); # set the type of language depdency $langDep_type = 2; # parse line die("$pkgFile($lineNum): Invalid package line\n") if (!($line =~ /^\s*\@\s*\"([^\"]*)\"/)); $file = $1; # don't count the size of this string # check the package file die("$pkgFile($lineNum): Not a .SIS file $file\n") if ($file !~ /.sis$/i); die("$pkgFile($lineNum): File $file not present\n") if (! -f $file); # add it to the list of language dependent thingies for updating later if($ubuild) { unshift(@langDep_tmp, $file); } else { push(@langDep_tmp, $file); } $langDep_count++; } # Handle the end of language dependent package line # # @param $line Line to process # sub handle_langDep_package_end { my ($line) = @_; my ($file, $uid, %file); # did we get the correct number of language dependent wotsits die("$pkgFile($lineNum): Wrong number of language dependent packages\n") if (scalar(@langDep_tmp) != scalar(@languages)); # parse line die("$pkgFile($lineNum): Invalid package line\n") if (!($line =~ /^\s*\}\s*,\s*\(\s*([0-9xa-fA-F]*)\s*\)/)); $uid = num($1); my @langDep_tmpname; foreach my $x (@langDep_tmp) { push(@langDep_tmpname, MakeSrcName($x, 2)); } # add in the string length of the first source file $strings_size += ULength($langDep_tmpname[0]); # make up new structure %file = ( "src", "srcname", \@langDep_tmpname, "dest", "", "langdep", 1, "type", 2, "misc", $uid ); # add it in push(@files, \%file); # not in lang dep section any more $in_langDep = 0; @langDep_tmp = (); } # Handle the depdency line # # @param $line Line to process # sub handle_dependency_line { my ($line) = @_; my ($uid, $major, $minor, $variant, $names, @names, %dependency); # parse line die("$pkgFile($lineNum): Invalid dependency line\n") if (!($line =~ /^\s*\(\s*([0-9a-fA-Fx]*)\s*\)\s*\,\s*([0-9]*)\s*,\s*([0-9]*)\s*,\s*([0-9]*)\s*,\s*\{(.*)\}\s*$/)); $uid = num($1); $major = $2; $minor = $3; $variant = $4; $names = $5; # chop up the names while($names =~ /\s*\"([^\"]*)\",?\s*/g) { push(@names, $1); $strings_size += ULength($1); } die("$pkgFile($lineNum): Invalid dependency line: Wrong number of languages\n") if (scalar(@names) != scalar(@languages)); # add in the dependency data %dependency = ( "uid", $uid, "major", $major, "minor", $minor, "variant", $variant, "names", \@names ); push(@dependencies, \%dependency); } # Parse a hex or decimal number # # @param num The number to parse # sub num { my ($num) = @_; $num = hex($num) if ($num =~ /^0x/); return($num); } # Calculates the CRC for a SIS file # # @param filename # sub doSisFileCrc { my ($filename) = @_; my ($crc, $buf, $size); # open the file open CRCFILE, "<$filename"; binmode(CRCFILE); # CRC the first 16 bytes $crc = 0; $size = sysread(CRCFILE, $buf, 16); $crc = doCrc($buf, $size, $crc); # skip 2 bytes where file CRC will go sysread(CRCFILE, $buf, 2); # do the rest of the file $size = sysread(CRCFILE, $buf, 4096); while($size > 0) { $crc = doCrc($buf, $size, $crc); $size = sysread(CRCFILE, $buf, 4096); } # return it return($crc); } # Calculates the UID-CRC for the specified set of three uids # # @param uid1 # @param uid2 # @param uid3 # sub doUidCrc { my ($uid1, $uid2, $uid3) = @_; my ($tmp, $buf1, $buf2, @tmp); # make up UID buffers @tmp = unpack("C12", pack("VVV", $uid1, $uid2, $uid3)); while(scalar(@tmp)) { $buf2 .= pack("C", shift(@tmp)); $buf1 .= pack("C", shift(@tmp)); } # CRC 'em & merge return (doCrc($buf1, 6, 0) << 16) | doCrc($buf2, 6, 0); } # Performs a CRC on a buffer # # @param buffer Buffer to CRC # @param length Length of buffer # sub doCrc { my ($buffer, $length, $crc) = @_; my ($i, $tmp); # do it! for($i=0; $i < $length; $i++) { # perform calc $tmp = unpack("C", substr($buffer, $i, 1)); $tmp ^= ($crc >> 8); $tmp &= 255; $crc = ($crcTable[$tmp] ^ ($crc<<8)) & 0xffff; } return($crc); }