Windows2003-3790/tools/postbuildscripts/symmake.pm
2020-09-30 16:53:55 +02:00

475 lines
12 KiB
Perl

package SymMake;
use lib $ENV{RAZZLETOOLPATH} . "\\PostBuildScripts";
use lib $ENV{RAZZLETOOLPATH};
use strict;
use Carp;
use IO::File;
use Data::Dumper;
use File::Basename;
use File::Find;
use Logmsg;
# Data structure
# pdbname.binext => [(var)pdbpath,size,$binext]
my ($DDFHandle, $CATHandle, $INFHandle);
my %pktypes = (
FULL => 'ARCH',
UPDATE => 'NTPB'
);
my %revpktypes = reverse %pktypes;
sub new {
my $class = shift;
my $instance = {
KB => {
"$pktypes{'FULL'}" => $_[0],
"$pktypes{'UPDATE'}" => $_[1]
},
SYM => {},
EXT => {},
HANDLE => {},
PKTYPE => undef
};
return bless $instance, $class;
}
sub ReadSource
{
my ($self, $symbolcd) = @_;
my ($fh, $kbterm, $mykey, @mylist);
local $_;
$kbterm = $pktypes{$self->{'PKTYPE'}};
$symbolcd = "$self->{'KB'}->{$kbterm}\\symbolcd\\symbolcd.txt" if (!defined $symbolcd);
$symbolcd = "$ENV{TEMP}\\symbolcd.txt" if (!-e $symbolcd);
if ($self->{'PKTYPE'} =~ /FULL/i) {
if (-e $symbolcd) { # reuse
($self->{'SYM'}, $self->{'EXT'}) = @{do $symbolcd};
} else { # create one
$self->HashArchServer($self->{'KB'}->{$kbterm});
# reuse
$Data::Dumper::Indent=1;
$Data::Dumper::Terse=1;
$fh = new IO::File $symbolcd, 'w';
if (!defined $fh) {
logmsg "Cannot open $symbolcd\.";
} else {
print $fh 'return [';
print $fh Dumper($self->{'SYM'});
print $fh ",\n";
print $fh Dumper($self->{'EXT'});
print $fh '];';
$fh->close();
}
}
} else {
$self->HashSymbolCD($symbolcd);
}
return;
#
# $Data::Dumper::Indent=1;
# $Data::T
# print Dumper($self->{'SYM'}, qw(sym)
}
sub HashSymbolCD
{
my ($self, $file) = @_;
my ($fh, $bin, $symbol, $subpath, $installpath, $kbterm);
local $_;
$kbterm = $pktypes{$self->{'PKTYPE'}};
$fh = new IO::File $file;
if (!defined $fh) {
logmsg "Cannot open symbolcd.txt ($file)";
return;
}
while(<$fh>) {
chomp;
($bin,$symbol,$subpath,$installpath)=split(/\,/,$_);
next if (!defined $installpath);
$self->{'SYM'}->{lc"$symbol\.$installpath"} = [$kbterm, "\\" . $subpath, (-s $self->{'KB'}->{$kbterm} . '\\' . $subpath), lc$installpath];
for (keys %pktypes) {
$self->{'EXT'}->{$_}->{lc$installpath} = 1;
}
}
$fh->close();
}
sub HashArchServer
{
my ($self, $path) = @_;
my ($fh, $bin, $symbol, $subpath, $installpath, $kbterm, $pdbsize);
local $_;
$kbterm = $pktypes{$self->{'PKTYPE'}};
$fh = new IO::File "dir /s/b/a-d $path\\*.*|";
if (!defined $fh) {
logmsg "Cannot access to $path\.";
}
while (<$fh>) {
chomp;
$pdbsize = (-s);
$_ = substr($_, length($path) + 1);
/\\/;
($symbol, $subpath, $installpath) = ($',$_,$`);
$self->{'SYM'}->{lc"$symbol\.$installpath"} = [$kbterm, '\\' . $subpath, $pdbsize, $installpath];
$self->{'EXT'}->{$self->{'PKTYPE'}}->{$installpath} = 1;
}
$fh->close();
}
#
# pkinfoptr->
# FULL ->
# CDFNAME =>
# INFNAME =>
#
sub Create_Symbols_CDF
{
my ($self, $pkinfoptr) = @_;
my ($mykbterm, $mypkname, $fhandle, $fullpdb, %mywriter);
local $_;
&Open_Private_Handle($pkinfoptr, 'CDF');
for $mypkname (keys %{$pkinfoptr}) {
if ($mypkname ne 'FULL') {
$mywriter{$mypkname} = &Writer($pkinfoptr->{$mypkname}->{'CDFHANDLE'}, $pkinfoptr->{'FULL'}->{'CDFHANDLE'});
} else {
$mywriter{$mypkname} = &Writer($pkinfoptr->{'FULL'}->{'CDFHANDLE'});
}
&Create_CDF_Head($pkinfoptr->{$mypkname}->{'CDFHANDLE'}, $pkinfoptr->{$mypkname}->{'CATNAME'}, $pkinfoptr->{$mypkname}->{'INFNAME'});
}
for (sort keys %{$self->{'SYM'}}) {
$mykbterm = $self->{'SYM'}->{$_}->[0];
$mypkname = $revpktypes{$mykbterm};
$fullpdb = $self->{'KB'}->{$mykbterm} . $self->{'SYM'}->{$_}->[1];
&{$mywriter{$mypkname}}("\<HASH\>" . $fullpdb . '=' . $fullpdb . "\n");
}
&Close_Private_Handle($pkinfoptr, 'CDF');
}
#
# pkinfoptr->
# FULL ->
# CABNAME =>
# CABDEST =>
# CABSIZE =>
# DDFLIST => (return cab list)
#
sub Create_Symbols_DDF
{
my ($self, $pkinfoptr) = @_;
my ($symkey, $symptr, $kbterm, $subpath, $pktype, $mypkinfoptr, $cabname, $ddfname, $cabcount, $DDFHandle, $myddfname, $mycabname);
local $_;
# initialization
map({$_->{'CURSIZE'} = $_->{'CABSIZE'}} values %{$pkinfoptr});
for (sort keys %{$self->{'SYM'}}) {
$symkey = $_;
$symptr = $self->{'SYM'}->{$_};
($kbterm, $subpath) = ($symptr->[0],$symptr->[1]);
$pktype = $revpktypes{$kbterm};
# don't generate something not specify
next if (!exists $pkinfoptr->{$pktype});
$mypkinfoptr = $pkinfoptr->{$pktype};
$mypkinfoptr->{'CURSIZE'}+=$symptr->[2];
if ($mypkinfoptr->{'CURSIZE'} >= $mypkinfoptr->{'CABSIZE'}) {
$mypkinfoptr->{'CURSIZE'} = $symptr->[2];
($cabname, $ddfname, $cabcount) = (
$mypkinfoptr->{'CABNAME'},
$mypkinfoptr->{'DDFNAME'},
++$mypkinfoptr->{'CABCOUNT'}
);
$myddfname = $ddfname . $cabcount . '.ddf';
$mycabname = $cabname . $cabcount . '.cab';
$mypkinfoptr->{'DDFHANDLE'} = new IO::File $myddfname, 'w';
if (!defined $mypkinfoptr->{'DDFHANDLE'}) {
logmsg "Cannot open DDF file $myddfname\.";
}
&Create_DDF_Head($mypkinfoptr->{'DDFHANDLE'}, $mycabname);
$mypkinfoptr->{'DDFLIST'}->{$myddfname} = $mycabname;
}
$DDFHandle = $mypkinfoptr->{'DDFHANDLE'};
print $DDFHandle '"' . $self->{'KB'}->{$kbterm} . $subpath . '" "' . $symkey . "\"\n";
}
&Close_Private_Handle($pkinfoptr, 'DDF');
}
#
# pkinfoptr->
# FULL ->
# INFNAME =>
# CDFNAME =>
#
sub Create_Symbols_INF
{
my ($self, $pkinfoptr) = @_;
my ($mypkname, $mypkinfoptr, $INFHandle, %mywriter, %mysepwriter, %h, %cabnames);
local $_;
&Open_Private_Handle($pkinfoptr, 'INF');
for $mypkname (keys %{$pkinfoptr}) {
($mypkinfoptr, $INFHandle) = ($pkinfoptr->{$mypkname}, $pkinfoptr->{$mypkname}->{'INFHANDLE'});
if ($mypkname ne 'FULL') {
$mywriter{$mypkname} = &Writer($INFHandle, $pkinfoptr->{'FULL'}->{'INFHANDLE'});
} else {
$mywriter{$mypkname} = &Writer($INFHandle);
}
$mysepwriter{$mypkname} = &Writer($INFHandle);
&Create_INF_Version($INFHandle, $mypkinfoptr->{'CATNAME'});
&Create_INF_Install($INFHandle, $self->{'EXT'}->{$mypkname});
$cabnames{$mypkname} = (FileParse($mypkinfoptr->{'CABNAME'}))[0];
}
&Create_INF_Files($self->{'SYM'}, \%mysepwriter, \%mywriter);
&Create_INF_SourceDisks($self->{'SYM'}, \%cabnames, \%mysepwriter, \%mywriter);
&Close_Private_Handle($pkinfoptr, 'INF');
}
sub Create_DDF_Head
{
my ($DDFHandle, $cabname) = @_;
my ($mycabname, $mycabdest) = FileParse($cabname);
print $DDFHandle <<DDFHEAD;
.option explicit
.Set DiskDirectoryTemplate=$mycabdest
.Set RptFileName=nul
.Set InfFileName=nul
.Set CabinetNameTemplate=$mycabname\.cab
.Set CompressionType=MSZIP
.Set MaxDiskSize=CDROM
.Set ReservePerCabinetSize=0
.Set Compress=on
.Set CompressionMemory=21
.Set Cabinet=ON
.Set MaxCabinetSize=999999999
.Set FolderSizeThreshold=1000000
DDFHEAD
}
sub Create_CDF_Head
{
my ($CDFHandle, $catname, $infname) = @_;
$catname = (FileParse($catname))[0];
print $CDFHandle <<CDFHEAD;
[CatalogHeader]
Name=$catname
PublicVersion=0x00000001
EncodingType=0x00010001
CATATTR1=0x10010001:OSAttr:2:5.X
[CatalogFiles]
\<HASH\>$infname\.inf=$infname\.inf
CDFHEAD
}
sub Create_INF_Version
{
my ($INFHandle, $catname) = @_;
$catname = (FileParse($catname))[0];
print $INFHandle <<INFVERSION;
[Version]
AdvancedInf= 2.5
Signature= "\$CHICAGO\$"
CatalogFile= $catname\.CAT
INFVERSION
}
sub Create_INF_Install
{
my ($INFHandle, $exthptr) = @_;
my $CopyFiles = 'Files.' . join(", Files\.", sort keys %{$exthptr});
print $INFHandle <<INF_INSTALL;
[DefaultInstall]
CustomDestination= CustDest
AddReg= RegVersion
BeginPrompt= BeginPromptSection
EndPrompt= EndPromptSection
RequireEngine= Setupapi;
CopyFiles= $CopyFiles
[DefaultInstall.Quiet]
CustomDestination=CustDest.2
AddReg= RegVersion
RequireEngine= Setupapi;
CopyFiles= $CopyFiles
[BeginPromptSection]
Title= "Microsoft Windows Symbols"
[EndPromptSection]
Title= "Microsoft Windows Symbols"
Prompt= "Installation is complete"
[RegVersion]
"HKLM","SOFTWARE\\Microsoft\\Symbols\\Directories","Symbol Dir",0,"\%49100\%"
"HKCU","SOFTWARE\\Microsoft\\Symbols\\Directories","Symbol Dir",0,"\%49100\%"
"HKCU","SOFTWARE\\Microsoft\\Symbols\\SymbolInstall","Symbol Install",,"1"
[SymCust]
"HKCU", "Software\\Microsoft\\Symbols\\Directories","Symbol Dir","Symbols install directory","\%25\%\\Symbols"
[CustDest]
49100=SymCust,1
[CustDest.2]
49100=SymCust,5
[DestinationDirs]
;49100 is \%systemroot\%\\symbols
Files.inf = 17
Files.system32 = 11
INF_INSTALL
for (sort keys %{$exthptr}) {
printf $INFHandle ("Files\.%-6s\t\t\= 49100,\"%s\"\n", $_, $_);
}
}
sub Create_INF_Files
{
my ($symptr, $sepwriter, $popwriter) = @_;
my ($mykbterm, $mypkname, %tags);
local $_;
for (sort {($symptr->{$a}->[3] cmp $symptr->{$b}->[3]) or ($a cmp $b)} keys %{$symptr}) {
$mykbterm = $symptr->{$_}->[0];
$mypkname = $revpktypes{$mykbterm};
if ($symptr->{$_}->[3] ne $tags{$mypkname}->[0]) {
$tags{$mypkname} = [$symptr->{$_}->[3], - length($symptr->{$_}->[3]) -1];
&{$sepwriter->{$mypkname}}("\n\[Files\.$tags{$mypkname}->[0]\]\n");
}
if ($symptr->{$_}->[3] ne $tags{'FULL'}->[0]) {
$tags{'FULL'} = [$symptr->{$_}->[3], - length($symptr->{$_}->[3]) -1];
&{$sepwriter->{'FULL'}}("\n\[Files\.$tags{'FULL'}->[0]\]\n");
}
&{$popwriter->{$mypkname}}(substr($_, 0, $tags{$mypkname}->[1]) . "\,$_\,\,4\n");
}
}
sub Create_INF_SourceDisks
{
my ($symptr, $cabnameptr, $sepwriter, $popwriter) = @_; # $pkinfoptr) = @_;
my ($INFHandle, $cabname, $mypkname);
local $_;
for (keys %{$cabnameptr}) {
$cabname = $cabnameptr->{$_};
&{$sepwriter->{$_}}(<<SOURCE_DISKS);
[SourceDisksNames]
1="$cabname\.cab",$cabname\.cab,0
[SourceDisksFiles]
SOURCE_DISKS
}
for (sort keys %{$symptr}) {
$mypkname = $revpktypes{$symptr->{$_}->[0]};
&{$popwriter->{$mypkname}}($_ . "=1\n");
}
}
#
# $pkinfoptr->
# $pktype ->
# CABNAME
# DDFNAME
# INFNAME
# CDFNAME
# CATNAME
# CABSIZE
#
# CABHANDLE
# DDFHANDLE
# INFHANDLE
#
# CABLIST
#
sub RegisterPackage
{
my ($pkinfoptr, $pktype, $hptr) = @_;
my ($mykey);
my @chklists = qw(CABNAME DDFNAME INFNAME CDFNAME CATNAME CABSIZE);
$pkinfoptr->{$pktype} = $hptr;
for $mykey (@chklists) {
die "$mykey not defined in $pktype" if (!exists $pkinfoptr->{$pktype}->{$mykey});
}
}
sub Writer {
my (@handles) = @_;
my ($hptr)=\@handles;
return sub {
my ($myhandle);
for $myhandle (@{$hptr}) {
print $myhandle $_[0];
}
};
}
sub Open_Private_Handle
{
my ($pkinfoptr, $ftype) = @_;
my ($pkname);
for $pkname (keys %{$pkinfoptr}) {
$pkinfoptr->{$pkname}->{$ftype . 'HANDLE'} = new IO::File $pkinfoptr->{$pkname}->{$ftype . 'NAME'} . '.' . $ftype, 'w';
if (!defined $pkinfoptr->{$pkname}->{$ftype . 'HANDLE'}) {
logmsg "Cannot open " . $pkinfoptr->{$pkname}->{$ftype . 'NAME'} . '.' . $ftype . ".";
}
}
}
sub Close_Private_Handle
{
my ($pkinfoptr, $ftype) = @_;
my ($pkname);
for $pkname (keys %{$pkinfoptr}) {
$pkinfoptr->{$pkname}->{$ftype . 'HANDLE'}->close() if (defined $pkinfoptr->{$pkname}->{$ftype . 'HANDLE'});
delete $pkinfoptr->{$pkname}->{$ftype . 'HANDLE'};
}
}
sub FileParse
{
my ($name, $path, $ext) = fileparse(shift, '\.[^\.]+$');
$ext =~ s/^\.//;
return $name, $path, $ext;
}
1;