windows-nt/Source/XPSP1/NT/inetsrv/iis/setup/imh6/iisinfsp.pl
2020-09-26 16:20:57 +08:00

472 lines
11 KiB
Perl

#
# iisinfsp.pl
#
# Perl script
#
# generates iis.inf for service packs from its gold version.
# goldfiles\<lang>\<arch>\iis.inf.gold are checked in files.
# this script pick up changes in iisend.inx, merge into iis.inf.
# it also find changed files from spfiles.txt, edit iis.inf
# so the source disk points to service pack CD.
# lastly, it update cdname section with mednames.txt
#
# the script is designed and tested for WinXP. it runs on two
# platforms: ia64 and x86.
#
######################################
# main program
#
sub ProcessInf;
sub prepare_change_list;
sub toUnicode;
sub toAnsi;
$setupinf = "$ENV{'SDXROOT'}\\MergedComponents\\SetupInfs\\";
local %edit_sections;
prepare_change_list();
# deal with all files in 'goldfiles\pro' folder
#
chdir("goldfiles/pro") or die "?";
@dirlist = <*>;
foreach $dir (@dirlist)
{
$lang = $dir;
if ($ENV{"_BuildArch"} =~ /x86/i)
{
chdir("$dir/x86fre") or die "could not cd to $dir/x86fre";
print "processing $dir/x86fre\n";
ProcessInf;
chdir("../..") or die "?";
}
if ($ENV{"_BuildArch"} =~ /ia64/i) #optional
{
if (chdir("$dir/ia64fre"))
{
print "processing $dir/ia64fre\n";
ProcessInf;
chdir("../..") or die "?";
}
}
}
chdir("../..") or die "?";
# deal with all files in 'goldfiles\per' folder
#
chdir("goldfiles/per") or die "?";
@dirlist = <*>;
foreach $dir (@dirlist)
{
$lang = $dir;
if ($ENV{"_BuildArch"} =~ /x86/i)
{
chdir("$dir/x86fre") or die "could not cd to $dir/x86fre";
# just copy then binplace iis.inf personal
$target = "$lang\\perinf";
$target = "perinf" if $lang=~ /usa/i;
system("copy iis.inf.gold iis.inf");
system("echo iis.inf $target >bp.txt");
system("binplace -p bp.txt iis.inf");
unlink("bp.txt");
chdir("../..") or die "?";
}
}
chdir("../..");
# end of main program
########################################
sub toUnicode
{
my $r = shift @_;
$r =~ s/(.)/$1\0/g;
$r =~ s/(\n)/$1\0/g;
return $r;
}
# !not a unicode-to-widechar conversion!
# it only works for ascii character. non-ascii characters a toasted
sub toAnsi
{
my $r = shift @_;
$r =~ s/\0//g;
return $r;
}
# unicode file may have 0x0a as part of a character
# keep reading until we see the sequence 0x0a 0x00 and call that a line.
# well, strictly speaking that's not correct as you can have two characters
# like (xx 0a) (00 yy). but this is unlikely, this func is a hack anyway.
sub unicodeReadline
{
my $file = shift @_;
my $r = "";
while (<$file>)
{
read ($file, $nextch, 1);
$r .= $_ . $nextch;
return $_=$r if ord($nextch) == 0;
}
return 0;
}
sub prepare_change_list
{
get_iisend_inx_changes();
get_spfiles_list();
}
sub get_spfiles_list
{
# get all files from spfiles.txt
#
open(SRC, "$ENV{SDXROOT}/tools/spfiles.txt") or die "could not open spfiles.txt";
while (<SRC>)
{
s/^.\s*//; # remove leading flag and spaces
s/.*[\\\/]//; # remove path, only need file name
next if /coUA\.css/i; # name collision, we didn't want to ship this file
$spfiles{$_}++;
}
close SRC;
}
# find all modified sections in iisend.inx,
# which will be merge changes to iis.inf.gold later
#
sub get_iisend_inx_changes
{
print "digesting iisend.inx changes\n";
# start by calling sd diff
#
#$ret = system("sd diff iisend.inx#1 iisend.inx#have > inf.tmp");
$ret = system("sd diff iisend.inx#1 iisend.inx > inf.tmp");
die "can't run sd diff" if $ret != 0;
open(SRC, "inf.tmp") or die "can't open inf.tmp";
my %lines;
my %new_sections;
# parse result from sd diff
#
while (<SRC>)
{
# changed lines
# 6183a6185,6187
if (/^\d/)
{
s/^[\d,]+[a-z](\d+).*/$1/;
$lines{0+$_}++;
}
# new section
# > @@!p:[OC_COMPLETE_INSTALLATION_install.iis_ftp.GUIMODE]
elsif (/^>.*:\[.*\]$/)
{
s/.*\[/\[/;
chomp;
$new_sections{lc($_)}++;
}
# deleted sections
# < @@!p:[OC_COMPLETE_INSTALLATION_install.iis_ftp.GUIMODE]
elsif (/^<.*:\[.*\]$/)
{
die "deleting sections from iis.inf not supported, just leave them empty"
}
}
close SRC;
if ($debug)
{
foreach $line (sort keys %lines)
{
print "$line, @lines{$line}\n";
}
}
# looking for sections where we had diffs
#
open(SRC, "iisend.inx") or die "can't open iisend.inx";
binmode(SRC);
$line = 0;
$sectioni = 0;
$sectionu = 0;
@section = (());
while (unicodeReadline(SRC))
{
$line++;
s/\0//g;
s/[\r\n]//g;
s/^@.*://;
if (@lines{$line} != 0)
{
$lines{$line} = \@{$section[$sectioni]};
$sectionu = 1;
}
if (/^\[/ && !($new_sections{lc($_)}))
{
$sectioni += $sectionu;
$sectionu = 0;
$section[$sectioni] = ();
}
push(@{$section[$sectioni]}, $_);
}
close(SRC);
if ($debug)
{
foreach $line (sort keys %lines)
{
foreach $txt (@{$lines{$line}})
{
print "$line, $txt \n";
}
}
}
# consolidate changed lines to hash
#
foreach $line (sort keys %lines)
{
@text = @{$lines{$line}};
$text[0] = lc(toUnicode($text[0] . "\r\n"));
$edit_sections{$text[0]} = toUnicode((join "\r\n", @text[1..$#text]) . "\r\n");
}
if ($debug)
{
foreach $section (keys %edit_sections)
{
print "\n$section\n$edit_sections{$section}";
}
}
}
# read mednames.txt for current language
# fake a section edit from it. that assumes the first line
# never changes (cdname)
#
sub get_mednames_txt_changes
{
my $path = "$setupinf$dir\\mednames.txt";
$path = "${setupinf}cht\\mednames.txt" if $dir =~ /CHH/i;
# prodfilt on mednames.txt
$ret = system("prodfilt $path mednames1.tmp +w >nul");
die "can't run prodfilt" if $ret != 0;
$ret = system("prodfilt mednames1.tmp mednames2.tmp +i >nul");
die "can't run prodfilt" if $ret != 0;
#print "reading mednames2.tmp\n";
# read in the file
open MEDFILE, "mednames2.tmp";
# not a unicode file, we just need its \r with \n
binmode MEDFILE;
while (<MEDFILE>) { last if /\S/ }
my $line1 = toUnicode(lc($_));
my $rest = "";
while (<MEDFILE>) { $rest .= toUnicode($_) };
close MEDFILE;
if ($debug)
{
print ">>>$line1<<<";
print $rest;
}
$edit_sections{$line1} = $rest;
unlink("mednames1.tmp");
unlink("mednames2.tmp");
}
sub ProcessInf
{
# add mednames.txt to edit_sections
get_mednames_txt_changes();
# get all file names from iis.inf.gold
# match files from spfiles.txt, record line number and file name
#
open(SRC, "iis.inf.gold") or die "could not open iis.ans";
binmode(SRC);
my @edits; # lines to edit
my %changefiles; # file names may need to change from IIS_xxx to xxx
my $x;
my $line = 0;
while (unicodeReadline(SRC))
{
$line++;
$_ = toAnsi($_);
$x+=2 if /^\[SourceDisksFiles\]/;
if ($x)
{
if (/=.*,/)
{
s/^IIS_//;
s/=.*//;
if ($spfiles{$_})
{
push @edits, $line;
chomp;
$changefiles{$_}++;
}
}
$x-- if /^\[/;
}
}
# munge iis.inf.gold to produce iis.inf
# 1) do section edits
# 2) do file location changes
open(SRC, "iis.inf.gold") or die "can't open iis.inf.gold";
open(DST, "> iis.inf") or die "can't open iis.inf";
binmode(SRC);
binmode(DST);
#binmode(STDOUT);
$line = 0;
push @edits, 999999; # in case the list is empty
@edits = reverse sort { $a <=> $b } @edits;
my $toline = pop(@edits);
while (unicodeReadline(SRC))
{
$line++;
while ($edit_sections{lc($_)})
{
$newtext = $edit_sections{lc($_)};
print DST $_;
if ($debug)
{
print toAnsi($_);
#print toAnsi($newtext);
}
#skip this section in source files
A: while (unicodeReadline(SRC))
{
$line++;
last A if /^\[/;
# end of section for mednames.txt
$_ = toAnsi($_);
if (/disk106/)
{
unicodeReadline(SRC);
$line++;
last A;
}
}
# print replacement
print DST $newtext;
# if we passed toline, we have a conflict
if ($line > $toline)
{
die "file relocation conflicts with manual edits (toline=$toline)";
}
}
if ($line == $toline)
{
# this file changed in service pack
s/^I\0I\0S\0_\0//; # remove prefix IIS_
s/\0=\0\61\0/\0=\0\64\0/; # change source disk from cab to SP
s/\0=\0\60\0/\0=\0\64\0/; # change source disk from gold to SP
$toline = pop(@edits);
}
elsif (/,\0I\0I\0S\0_\0/)
{
# get file name after ,IIS_
my $org = $_;
$_ = toAnsi($_);
# special case (sigh)
# this is a hack. query.asp2 only exists in localized builds
# server version of query.asp was not localized, but is
# packaged in XP media regardless. the build script give them
# two names and put them all in the media. we really want to
# fix query.asp2 in those builds. same situation exists for
# search.asp and default.asp - everything in iisdoc_files_ismcore_misc_shared
#
s/query.asp2/query.asp/;
s/search.asp2/search.asp/;
s/default.asp2/default.asp/;
@comp = split /,IIS_([\w\d\.]+)\b/;
if ($changefiles{$comp[1]})
{
$_ = toUnicode("$comp[0],$comp[1]$comp[2]");
}
else
{
$_ = $org;
}
}
print DST $_;
}
close SRC;
close DST;
# binplace this file
$target = $lang;
$target = "." if $lang=~ /usa/i;
system("echo iis.inf $target >bp.txt");
system("binplace -p bp.txt iis.inf");
# unlink("bp.txt");
}