Hi,
On Tue, 29 Sep 2009, Eric House wrote:
We've discussed before that the free-software tools for building .cab
files on Linux produce files that Smartphone (but not PocketPC)
doesn't recognize. But I wonder if anybody's found a way around this.
I don't know what has been discussed before, but I assume you're referring
to pocketpc-cab, which makes .cab files that only work on PocketPC, not on
Smartphone.
I've made a few changes/improvements to this tool (that I haven't had time
to feed upstream to get properly integrated yet, unfortunately), so that
it should be able to create .cab files that work on Smartphone, too.
Additionally, I've added support for creating shortcuts and for adding
registry entries.
Attached here is my version of this script, I hope you find it useful!
// Martin
#!/usr/bin/perl -w
# Build an installable Pocket PC cabinet file.
# Copyright 2006 Shaun Jackman
use strict;
use Getopt::Long;
use Pod::Usage;
use Text::ParseWords;
use MIME::Base64;
# Constants.
my $architecture = 0;
my @version_requirements = (4, 0, 6, 99, 0, -536870912); # 4.0.0 to
6.99.0xE0000000 (-536870912)
my $verbose = 0;
# Strings.
my $string_count = 0;
my %string_ids;
# Directories.
my $directory_count = 0;
my %directory_ids;
my @directories;
# Files.
my $file_count = 0;
my %file_ids;
my %file_dirs;
my @files;
# RegHives.
my $reghive_count = 0;
my %reghive_ids;
my @reghive_roots;
my @reghives;
# RegKeys.
my $regkey_count = 0;
my %regkey_ids;
my @regkey_hives;
my @regkey_keys;
my @regkey_names;
my @regkey_values;
my @regkey_xmlvalues;
my @regkey_types;
my @regkey_typeids;
# Links.
my $links_count = 0;
my %links;
my %link_targets;
my %link_dirs;
# Returns the ID of the specified string.
sub get_string_id($)
{
my $string = shift;
my $id = $string_ids{$string};
if( defined $id) {
return $id;
} else {
$id = ++$string_count;
$string_ids{$string} = $id;
return $id;
}
}
# Returns the ID of the specified directory.
sub get_directory_id($)
{
my $directory = shift;
my $id = $directory_ids{$directory};
if( defined $id) {
return $id;
} else {
$id = ++$directory_count;
$directory_ids{$directory} = $id;
my @strings = split '/', $directory;
my @ids;
foreach my $string (@strings) {
next if length $string == 0;
push @ids, get_string_id( $string);
}
push @ids, 0;
$directories[$id] = \...@ids;
return $id;
}
}
# Returns the ID of the specified registry key
sub get_reghive_id($$)
{
my $root = shift;
my $key = shift;
my $hive_name = "$root/$key";
my $id = $reghive_ids{$hive_name};
if( defined $id) {
return $id;
} else {
$id = ++$reghive_count;
$reghive_ids{$hive_name} = $id;
my @strings = split '/', $key;
my @ids;
foreach my $string (@strings) {
next if length $string == 0;
push @ids, get_string_id( $string);
}
push @ids, 0;
$reghives[$id] = \...@ids;
$reghive_roots[$id] = $root;
return $id;
}
}
sub parseint($)
{
my $str = shift;
if ($str =~ /^0x/i) {
return hex($str);
} elsif ($str =~ /^0b/i) {
return oct($str);
} else {
return int($str);
}
}
# Returns a list of keys sorted by value.
sub get_value_sorted_keys(%)
{
my %hash = @_;
return sort { $hash{$a} <=> $hash{$b} } keys %hash;
}
# Creates the files.
sub parse_input($)
{
my $destdir = shift;
while(<>) {
my ($file, $directory, $linkname, $linkdir) = &shellwords($_);
next if length $directory == 0;
my $id = ++$file_count;
$file_ids{$file} = $id;
$file_dirs{$file} = "$destdir$directory";
$files[$id] = get_directory_id "$destdir$directory";
if (defined $linkdir) {
$linkname .= '.lnk';
$link_targets{$linkname} = "$destdir$directory/$file";
$link_dirs{$linkname} = $linkdir;
my $linknameid = get_string_id $linkname;
my $dirid = 0;
my $basedir = 0;
if ($linkdir =~ /^%CE(\d+)%$/) {
$basedir = $1;
} else {
$dirid = get_directory_id $linkdir;
}
my @strings = split '/', $linkname;
my @stringids;
foreach my $string (@strings) {
next if length $string == 0;
push @stringids, get_string_id $string;
}
my $fileid = $id;
my $id = ++$links_count;
my $type = 1;
$links{$id} = [ $dirid, $basedir, $fileid, 1, [
@stringids ] ];
}
}
}
sub parse_regfile($)
{
my $regfile = shift;
open REGFILE, "<$regfile";
while(<REGFILE>) {
my @line = &shellwords($_);
my $root = shift @line;
my $key = shift @line;
my $name = shift @line;
my $type = shift @line;
my $value = shift @line;
next if length $root == 0;
$root = uc($root);
my $rootid;
if ($root eq "HKCR") {
$rootid = 1;
} elsif ($root eq "HKCU") {
$rootid = 2;
} elsif ($root eq "HKLM") {
$rootid = 3;
} elsif ($root eq "HKU") {
$rootid = 4;
} else {
print STDERR "Unrecognised registry root $root\n";
next;
}
$type = lc($type);
my $manifest_value = '';
my $xml_value = '';
my $typeid;
if ($type eq "string") {
$manifest_value = $value . "\0";
$xml_value = $value;
$typeid = 0x00000000;
$type = "string";
} elsif ($type eq "binary") {
$manifest_value = '';
while (length $value > 0) {
my $byte = hex(substr $value,0,2,'');
$manifest_value .= pack 'C',$byte;
}
$xml_value = encode_base64($manifest_value);
chomp $xml_value;
$typeid = 0x00000001;
$type = "binary";
} elsif ($type eq "integer" || $type eq "int" || $type eq
"dword") {
my $int = parseint($value);
$manifest_value = pack 'V', $int;
$xml_value = "$int";
$typeid = 0x00010001;
$type = "integer";
} elsif ($type eq "multistring") {
my @strings;
push @strings, $value if defined $value;
push @strings, @line;
$manifest_value = '';
$xml_value = '';
foreach my $string (@strings) {
$manifest_value .= $string . "\0";
$xml_value .= $string . "\xEF\x80\x80"; #
separate using EF8080, which is 0xF000 encoded as utf8
}
$manifest_value .= "\0";
$typeid = 0x00010000;
$type = "multiplestring";
} else {
print STDERR "Unrecognised registry type $type\n";
next;
}
my $id = ++$regkey_count;
$regkey_ids{$id} = $id;
$regkey_hives[$id] = get_reghive_id $rootid, $key;
$regkey_keys[$id] = "$root/$key";
$regkey_names[$id] = $name;
$regkey_values[$id] = $manifest_value;
$regkey_xmlvalues[$id] = $xml_value;
$regkey_typeids[$id] = $typeid;
$regkey_types[$id] = $type;
}
close REGFILE;
}
# Returns the entire manifest.
sub get_manifest($$)
{
my ($provider, $application) = @_;
# Header.
my $offset = 100;
# Application.
my $application_offset = $offset;
$application .= "\0";
while ((length $application) % 4 != 0) {
$application .= "\0";
}
$offset += length $application;
# Provider.
my $provider_offset = $offset;
$provider .= "\0";
while ((length $provider) % 4 != 0) {
$provider .= "\0";
}
$offset += length $provider;
# Unsupported platforms.
my $unsupported_offset = $offset;
my $unsupported = '';
$offset += length $unsupported;
# Strings.
my $strings_offset = $offset;
my $strings = '';
foreach my $string (get_value_sorted_keys %string_ids) {
my $string_id = $string_ids{$string};
print "$string($string_id)\n" if $verbose;
$string .= "\0";
while ((length $string) % 4 != 0) {
$string .= "\0";
}
$strings .= pack 'vv', $string_id, length $string;
$strings .= $string;
}
$offset += length $strings;
# Directories.
my $directories_offset = $offset;
my $directories = '';
foreach my $directory (get_value_sorted_keys %directory_ids) {
my $directory_id = $directory_ids{$directory};
my @ids = @{$directories[$directory_id]};
print "$directory($directory_id): @ids\n" if $verbose;
$directories .= pack 'vv', $directory_id, 2 * scalar @ids;
foreach my $id (@ids) {
$directories .= pack 'v', $id;
}
}
$offset += length $directories;
# Files.
my $files_offset = $offset;
my $files = '';
foreach my $path (get_value_sorted_keys %file_ids) {
my $file_id = $file_ids{$path};
my $directory_id = $files[$file_id];
my $file = $path;
$file =~ s/^.*\///;
$file .= "\0";
while ((length $file) % 4 != 0) {
$file .= "\0";
}
print "$file($file_id): $directory_id\n" if $verbose;
$files .= pack 'vvvVv', $file_id, $directory_id, $file_id,
0, length $file;
$files .= $file;
}
$offset += length $files;
# RegHives.
my $reghives_offset = $offset;
my $reghives = '';
foreach my $reghive (get_value_sorted_keys %reghive_ids) {
my $reghive_id = $reghive_ids{$reghive};
my $reghive_root = $reghive_roots[$reghive_id];
my @ids = @{$reghives[$reghive_id]};
print "$reghive($reghive_id): @ids\n" if $verbose;
$reghives .= pack 'vvvv', $reghive_id, $reghive_root, 0, 2 *
scalar @ids;
foreach my $id (@ids) {
$reghives .= pack 'v', $id;
}
}
$offset += length $reghives;
# RegKeys.
my $regkeys_offset = $offset;
my $regkeys = '';
foreach my $regkey_id (get_value_sorted_keys %regkey_ids) {
my $hive = $regkey_hives[$regkey_id];
my $name = $regkey_names[$regkey_id];
my $value = $regkey_values[$regkey_id];
my $len = length($value);
my $typeid = $regkey_typeids[$regkey_id];
print "$name($regkey_id): \n" if $verbose;
$regkeys .= pack 'vvvVv', $regkey_id, $hive, 0, $typeid,
length($name) + 1 + length($value);
$regkeys .= $name . "\0" . $value;
}
$offset += length $regkeys;
# Links.
my $links_offset = $offset;
my $links = '';
foreach my $link_id (keys %links) {
my @link = @{ $links{$link_id} };
my $dirid = $link[0];
my $basedir = $link[1];
my $fileid = $link[2];
my $type = $link[3];
my @stringids = @{ $link[4] };
my $length = 2 * scalar @stringids;
$links .= pack 'vvvvvv', $link_id, $dirid, $basedir, $fileid,
$type, $length;
foreach my $id (@stringids) {
$links .= pack 'v', $id;
}
}
$offset += length $links;
# Header.
my $length = $offset;
my @fields = (
0, $length, 0, 1, $architecture,
@version_requirements,
$string_count, $directory_count, $file_count,
$reghive_count, $regkey_count, $links_count,
$strings_offset, $directories_offset, $files_offset,
$reghives_offset, $regkeys_offset, $links_offset,
$application_offset, length $application,
$provider_offset, length $provider,
$unsupported_offset, length $unsupported,
0, 0);
my $header = 'MSCE';
$header .= pack 'V11 v6 V6 v8', @fields;
return $header . $application . $provider . $unsupported .
$strings . $directories . $files .
$reghives . $regkeys . $links;
}
# Returns a munged version of the specified filename.
# Removes the leading path. Removes the extension. Removes spaces.
# Truncates to eight characters. Pads to eight characters with leading
# zeros. Adds a numeric extension.
sub munge_filename($$)
{
my $munged = shift;
my $extension = shift;
$munged =~ s/^.*\///;
$munged =~ s/\..*$//;
$munged =~ s/ //;
$munged = substr $munged, 0, 8;
$munged = sprintf '%08s.%03d', $munged, $extension;
return $munged;
}
# Returns the _setup.xml file
sub get_setupxml($$)
{
my ($provider, $application) = @_;
my $output;
$output .= "<wap-provisioningdoc>\n";
$output .= "\t<characteristic type=\"Install\">\n";
$output .= "\t\t<parm name=\"InstallPhase\" value=\"install\" />\n";
$output .= "\t\t<parm name=\"OSVersionMin\"
value=\"$version_requirements[0].$version_requirements[1]\" />\n";
$output .= "\t\t<parm name=\"OSVersionMax\"
value=\"$version_requirements[2].$version_requirements[3]\" />\n";
$output .= "\t\t<parm name=\"BuildNumberMin\"
value=\"$version_requirements[4]\" />\n";
$output .= "\t\t<parm name=\"BuildNumberMax\"
value=\"$version_requirements[5]\" />\n";
$output .= "\t\t<parm name=\"AppName\" value=\"$provider $application\"
/>\n";
my @filenames = get_value_sorted_keys %file_ids;
my $firstdir = $file_dirs{$filenames[0]};
$firstdir =~ s/\//\\/g;
$output .= "\t\t<parm name=\"InstallDir\" value=\"$firstdir\"
translation=\"install\" />\n";
my $dirs = scalar keys %directory_ids;
my $files = scalar keys %file_ids;
$output .= "\t\t<parm name=\"NumDirs\" value=\"$dirs\" />\n";
$output .= "\t\t<parm name=\"NumFiles\" value=\"$files\" />\n";
$output .= "\t\t<parm name=\"NumRegKeys\" value=\"$regkey_count\" />\n";
$output .= "\t\t<parm name=\"NumRegVals\" value=\"$regkey_count\" />\n";
my $shortcuts = scalar keys %links;
$output .= "\t\t<parm name=\"NumShortcuts\" value=\"$shortcuts\" />\n";
$output .= "\t</characteristic>\n";
$output .= "\t<characteristic type=\"FileOperation\">\n";
foreach my $path (get_value_sorted_keys %file_ids) {
my $file_id = $file_ids{$path};
my $dir = $file_dirs{$path};
my $file = $path;
$file =~ s/^.*\///g;
$file =~ s/\//\\/g;
$dir =~ s/\//\\/g;
my $munged_file = munge_filename $file, $file_id;
$output .= "\t\t<characteristic type=\"$dir\"
translation=\"install\">\n";
$output .= "\t\t\t<characteristic type=\"MakeDir\" />\n";
$output .= "\t\t\t<characteristic type=\"$file\"
translation=\"install\">\n";
$output .= "\t\t\t\t<characteristic type=\"Extract\">\n";
$output .= "\t\t\t\t\t<parm name=\"Source\"
value=\"$munged_file\" />\n";
$output .= "\t\t\t\t</characteristic>\n";
$output .= "\t\t\t</characteristic>\n";
$output .= "\t\t</characteristic>\n";
}
foreach my $link (get_value_sorted_keys %link_dirs) {
my $link_dir = $link_dirs{$link};
my $link_target = $link_targets{$link};
$link =~ s/\//\\/g;
$link_dir =~ s/\//\\/g;
$link_target =~ s/\//\\/g;
$output .= "\t\t<characteristic type=\"$link_dir\"
translation=\"install\">\n";
$output .= "\t\t\t<characteristic type=\"MakeDir\" />\n";
$output .= "\t\t\t<characteristic type=\"$link\"
translation=\"install\">\n";
$output .= "\t\t\t\t<characteristic type=\"Shortcut\">\n";
$output .= "\t\t\t\t\t<parm name=\"Source\"
value=\"$link_target\" translation=\"install\" />\n";
$output .= "\t\t\t\t</characteristic>\n";
$output .= "\t\t\t</characteristic>\n";
$output .= "\t\t</characteristic>\n";
}
$output .= "\t</characteristic>\n";
$output .= "\t<characteristic type=\"Registry\">\n";
foreach my $regkey_id (get_value_sorted_keys %regkey_ids) {
my $key = $regkey_keys[$regkey_id];
my $name = $regkey_names[$regkey_id];
my $type = $regkey_types[$regkey_id];
my $value = $regkey_xmlvalues[$regkey_id];
$key =~ s/\//\\/g;
$output .= "\t\t<characteristic type=\"$key\">\n";
$output .= "\t\t\t<parm name=\"$name\" value=\"$value\"
datatype=\"$type\" />\n";
$output .= "\t\t</characteristic>\n";
}
$output .= "\t</characteristic>\n";
$output .= "</wap-provisioningdoc>\n";
return $output;
}
# Prints the version message and exits.
sub version()
{
print
"pocketpc-cab 1.0.1\n" .
"Written by Shaun Jackman <sjackm...@gmail.com>.\n" .
"\n" .
"Copyright 2006 Shaun Jackman\n" .
"This is free software; see the source for copying\n" .
"conditions. There is NO warranty; not even for\n" .
"MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
exit 0;
}
# Main.
sub main()
{
# Parse the command line.
my $provider = 'Provider';
my $application = 'Application';
my $sourcedir = '';
my $destdir = '';
my $regfile;
GetOptions(
"provider=s" => \$provider,
"application=s" => \$application,
"source=s" => \$sourcedir,
"dest=s" => \$destdir,
"registry=s" => \$regfile,
"verbose|v!" => \$verbose,
"help|?" => sub { pod2usage(
-exitstatus => 0, -verbose => 1) },
"man" => sub { pod2usage(
-exitstatus => 0, -verbose => 2) },
"version" => \&version);
$sourcedir .= '/' if length $sourcedir > 0;
$destdir .= '/' if length $destdir > 0;
if( scalar @ARGV < 1) {
print
"pocketpc-cab: missing file arguments\n" .
"Try `pocketpc-cab --help' for more information.\n";
exit 1;
}
my $cab_filename = pop @ARGV;
# Parse the input file.
parse_input( $destdir);
parse_regfile($regfile) if defined $regfile;
# Create the manifest.
my $manifest = "manifest.000";
open MANIFEST, ">$manifest";
binmode MANIFEST;
print MANIFEST get_manifest( $provider, $application);
close MANIFEST;
# Create the _setup.xml
my $setupxml = "_setup.xml";
open SETUPXML, ">$setupxml";
print SETUPXML get_setupxml( $provider, $application);
close SETUPXML;
# Copy the data files.
my $munged_files = " $setupxml";
my $i = 0;
foreach my $file (get_value_sorted_keys %file_ids) {
my $munged_file = munge_filename $file, ++$i;
print "$file: $munged_file\n" if $verbose;
`cp "$sourcedir$file" "$munged_file"`;
exit $? >> 8 if $? > 0;
$munged_files = ' ' . $munged_file . $munged_files;
}
$munged_files = 'manifest.000' . $munged_files;
# Create the cab.
print "$cab_filename: $munged_files\n" if $verbose;
my $lcab_output = `lcab $munged_files $cab_filename`;
exit $? >> 8 if $? > 0;
print $lcab_output if $verbose;
`rm $munged_files`;
}
# Entry-point.
main;
__END__
=head1 NAME
pocketpc-cab - build an installable Pocket PC cabinet file
=head1 SYNOPSIS
B<pocketpc-cab> [I<OPTION>]... I<INPUTFILE> I<CABINET>
=head1 DESCRIPTION
Read the INPUTFILE, which is a list of filenames and destination
directories, and create CABINET, a cabinet file, that will install
those files into the specified directories.
=head1 OPTIONS
=over
=item B<-p, --provider>=I<PROVIDER>
set the provider name
=item B<-a, --application>=I<APPLICATION>
set the application name
=item B<-s, --source>=I<SOURCE>
set the source directory
=item B<-d, --dest>=I<DEST>
set the destination directory
=item B<-r, --registry>=I<REGISTRYFILE>
use a registry specification file
=item B<-v, --verbose>
display verbose output
=item B<--help>
display a brief help message
=item B<--man>
display the full documentation
=back
=head1 EXAMPLES
$ cat > foobar.files <<EOF
foobar.exe /bin "Shortcut Name" %CE11%
foobar.dll /windows
EOF
$ cat > foobar.regkeys <<EOF
HKCU Software/Fooware/Foobar Name string "Some string"
HKCU Software/Fooware/Foobar Data binary 00112233445566778899aabbccddeeff
HKCU Software/Fooware/Foobar Value integer 42
HKCU Software/Fooware/Foobar HexValue integer 0xff
HKCU Software/Fooware/Foobar Names multistring "String 1" "String 2"
EOF
$ pocketpc-cab -p Fooware -a FooBar -r foobar.regkeys foobar.files foobar.cab
=head1 AUTHOR
Written by Shaun Jackman.
=head1 REPORTING BUGS
Report bugs to Shaun Jackman <sjack...@gmail.com>.
=head1 COPYRIGHT
Copyright 2006 Shaun Jackman
This is free software; see the source for copying conditions. There is
NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE.
=head1 SEE ALSO
=over
=item B<lcab>(1)
create cabinet archives
=item B</usr/share/doc/pocketpc-cab/wince_cab_format.html>
Windows CE installation cabinet file format
=back
=cut
ChangeLog
2006-04-06 Shaun Jackman <sjack...@gmail.com>
* Release version 1.0.1.
* Fix the CAB for WinCE5 by putting the manifest.000 file first in
the cabinet file.
Thanks to Rouven SchÃŒrch <rouven.schue...@tegonal.com>.
2004-09-17 Shaun Jackman <sjack...@debian.org>
* Initial release, version 1.0.0.
------------------------------------------------------------------------------
Come build with us! The BlackBerry® Developer Conference in SF, CA
is the only developer event you need to attend this year. Jumpstart your
developing skills, take BlackBerry mobile applications to market and stay
ahead of the curve. Join us from November 9-12, 2009. Register now!
http://p.sf.net/sfu/devconf
_______________________________________________
Cegcc-devel mailing list
Cegcc-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/cegcc-devel
