519 lines
14 KiB
Perl
519 lines
14 KiB
Perl
#+---------------------------------------------------------------------------
|
|
#
|
|
# Microsoft Windows
|
|
# Copyright (C) Microsoft Corporation, 1998.
|
|
#
|
|
# File: C H K A F . P L
|
|
#
|
|
# Contents: Perl script to check the networking portion of
|
|
# an answerfile.
|
|
#
|
|
# Notes:
|
|
#
|
|
# Author: kumarp 21-August-98
|
|
#
|
|
#----------------------------------------------------------------------------
|
|
|
|
#----------------------------------------------------------------------------
|
|
# Known issues:
|
|
# - None at present
|
|
#
|
|
# Future enhancements:
|
|
# - check if the value assigned to all known keys are valid. this can
|
|
# be done by having a hash having {<key> => <regex-to-check>} pairs
|
|
# for each key to check.
|
|
# e.g. { 'DHCP' => 'yes|no' }
|
|
# - check syntax of entries in the [NetBindings] section.
|
|
# - check for empty values that will cause winnt32 to croak
|
|
# e.g. key=
|
|
#----------------------------------------------------------------------------
|
|
|
|
#use strict;
|
|
|
|
#----------------------------------------------------------------------------
|
|
# Open the answerfile and read in all sections and their contents
|
|
# into a hash so that further processing is easier
|
|
#
|
|
my %inf;
|
|
my $CurrentSection="";
|
|
my $CurrentFile=$ARGV[0];
|
|
|
|
open(AFILE, "<$CurrentFile") || die "Cannot open $ARGV[0]: $!";
|
|
|
|
while (<AFILE>)
|
|
{
|
|
next if (/^\s*;/);
|
|
|
|
if (/^\s*\[([^\]]+)\]/)
|
|
{
|
|
$CurrentSection=$1;
|
|
store_key($CurrentSection, "", "");
|
|
}
|
|
elsif (/\"?([a-zA-Z0-9_\.]+)\"?\s*=\s*([^\n]*)/)
|
|
{
|
|
my ($key, $value);
|
|
my @value_items;
|
|
|
|
if ($CurrentSection eq "")
|
|
{
|
|
die "Keys outside a section?";
|
|
}
|
|
|
|
$key = $1;
|
|
@value_items = strip_quotes(split(/,/, $2));
|
|
$value = join(",", @value_items);
|
|
|
|
store_key($CurrentSection, $key, $value);
|
|
}
|
|
}
|
|
|
|
close(AFILE);
|
|
|
|
# ----------------------------------------------------------------------
|
|
# Must have [Networking] section
|
|
#
|
|
if (! exists($inf{'Networking'}))
|
|
{
|
|
show_error('', '', "[Networking] section is missing!");
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# Atleast one of the following sections needs to be present
|
|
# [NetAdapters], [NetProtocols], [NetClients], [NetServices]
|
|
#
|
|
if (!(exists($inf{'NetAdapters'}) ||
|
|
exists($inf{'NetProtocols'}) ||
|
|
exists($inf{'NetClients'}) ||
|
|
exists($inf{'NetServices'})) &&
|
|
!exists($inf{'Networking'}{lc('InstallDefaultComponents')}))
|
|
{
|
|
show_error("", "", "None of the following sections are present, are you sure this is an answerfile ?\n--> [NetAdapters], [NetProtocols], [NetClients], [NetServices]");
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# the following keywords are obsolete in an adapter params section
|
|
#
|
|
my @obsolete_keywords_adapter =
|
|
('detect');
|
|
|
|
# ----------------------------------------------------------------------
|
|
# - Must use InfId key in each adapter-params section
|
|
# - '*' can be used if only one adapter is specified
|
|
#
|
|
my $adapter;
|
|
|
|
foreach $adapter (keys %{$inf{'NetAdapters'}})
|
|
{
|
|
my $params_section;
|
|
|
|
next if ($adapter eq "");
|
|
$params_section = $inf{'NetAdapters'}{$adapter};
|
|
if (!defined($inf{$params_section}{'infid'}))
|
|
{
|
|
show_error($params_section, "", "Adapter parameters section must have InfId");
|
|
}
|
|
else
|
|
{
|
|
if (($inf{$params_section}{'infid'} eq '*') &&
|
|
(keys %{$inf{'NetAdapters'}} > 2))
|
|
{
|
|
show_error($params_section, 'InfId', "When you have more than one net cards, you cannot use '*' as value of InfId");
|
|
}
|
|
}
|
|
|
|
check_for_obsolete_keys($params_section, \@obsolete_keywords_adapter);
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# - adapter pointed to by SpecificTo key must exist in [NetAdapters] section
|
|
# - all sections pointed to by AdapterSections must exist
|
|
# - each section that has a SpecificTo key must be referenced by
|
|
# AdapterSections key
|
|
#
|
|
my $section;
|
|
|
|
foreach $section (keys %inf)
|
|
{
|
|
if (exists($inf{$section}{'specificto'}))
|
|
{
|
|
my $adapter;
|
|
|
|
$adapter = $inf{$section}{'specificto'};
|
|
if (!exists($inf{'NetAdapters'}{lc($adapter)}))
|
|
{
|
|
show_error($section, 'SpecificTo',
|
|
"$adapter is not defined in section [NetAdapters]");
|
|
}
|
|
|
|
my $ref_found = 0;
|
|
foreach $tsection (keys %inf)
|
|
{
|
|
if (exists($inf{$tsection}{'adaptersections'}))
|
|
{
|
|
my @adapter_sections =
|
|
split(/,/, $inf{$tsection}{'adaptersections'});
|
|
if (is_in_list($section, \@adapter_sections))
|
|
{
|
|
$ref_found = 1;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
if (!$ref_found)
|
|
{
|
|
show_error($section, '', "this section seems to hold adapter specific parameters of '$adapter', but no protocol parameters section references it using 'AdapterSections' key");
|
|
}
|
|
}
|
|
|
|
if (exists($inf{$section}{'adaptersections'}))
|
|
{
|
|
my $section_list;
|
|
my $adapter_section;
|
|
my @adapter_sections;
|
|
|
|
$section_list = $inf{$section}{'adaptersections'};
|
|
@adapter_sections = split(/,/, $section_list);
|
|
foreach $adapter_section (@adapter_sections)
|
|
{
|
|
if (!exists($inf{$adapter_section}))
|
|
{
|
|
show_error($section, 'AdapterSections', "section $adapter_section does not exist");
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# - when specifying [NetBindings] section, atleast the following
|
|
# sections must be specified:
|
|
# --> [NetAdapters], [NetProtocols]
|
|
#
|
|
if (exists($inf{'NetBindings'}) &&
|
|
!(exists($inf{'NetAdapters'}) && exists($inf{'NetProtocols'})))
|
|
{
|
|
show_error('NetBindings', '', "When using this section, you should also specify atleast the following sections: [NetAdapters], [NetProtocols]");
|
|
}
|
|
|
|
my @obsolete_keywords_non_adapter =
|
|
('infid');
|
|
|
|
# ----------------------------------------------------------------------
|
|
# - make sure all components specified in [Net*] sections are
|
|
# known components. if not, either it is a new component or it is a typo.
|
|
#
|
|
my $known_components =
|
|
{
|
|
'NetProtocols' => ['', 'MS_TCPIP', 'MS_NWIPX', 'MS_PPTP', 'MS_L2TP',
|
|
'MS_DLC', 'MS_AppleTalk', 'MS_NetBEUI', 'MS_NetMon',
|
|
'MS_ATMLANE', 'MS_AtmUni', 'MS_AtmArps', 'MS_GPC'],
|
|
'NetClients' => ['', 'MS_MSClient', 'MS_NWClient'],
|
|
'NetServices' => ['', 'MS_Server', 'MS_RasCli', 'MS_RasSrv', 'MS_RasRtr']
|
|
};
|
|
|
|
foreach $section (keys %$known_components)
|
|
{
|
|
my @components = keys %{$inf{$section}};
|
|
if (@components)
|
|
{
|
|
my @known_component_list = @{$$known_components{$section}};
|
|
foreach $component (@components)
|
|
{
|
|
if (!is_in_list($component, \@known_component_list))
|
|
{
|
|
show_error($section, $component, "'$component' is not known to be valid component in section [$section]");
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# - make sure that global & adapter-specific parameters are not
|
|
# specified in the wrong section
|
|
# - warn about any parameters that are not known to be valid for a component
|
|
#
|
|
my $params =
|
|
{
|
|
'MS_TCPIP' =>
|
|
{
|
|
'global' => ['DNS', 'DNSSuffixSearchOrder',
|
|
'UseDomainNameDevolution', 'EnableSecurity',
|
|
'ScopeID', 'EnableLMHosts',
|
|
# find out if the following are still valid
|
|
'EnableIpForwarding'],
|
|
'adapter' => ['DNSServerSearchOrder',
|
|
'WINS', 'WinsServerList',
|
|
'NetBiosOption', 'DhcpClassId', 'DNSDomain',
|
|
'DHCP', 'IPAddress', 'SubnetMask',
|
|
'DefaultGateway'],
|
|
},
|
|
|
|
'MS_NWIPX' =>
|
|
{
|
|
'global' => ['VirtualNetworkNumber', 'DedicatedRouter',
|
|
'EnableWANRouter',
|
|
# find out if the following are still valid
|
|
'RipRoute'],
|
|
'adapter' => ['PktType', 'NetworkNumber',
|
|
# find out if the following are still valid
|
|
'MaxPktSize', 'BindSap', 'EnableFuncaddr',
|
|
'SourceRouteDef', 'SourceRouteMcast', 'SourceRouting'],
|
|
},
|
|
|
|
'MS_PPTP' =>
|
|
{
|
|
'global' => ['NumberLineDevices'],
|
|
'adapter' => [],
|
|
},
|
|
|
|
'MS_AppleTalk' =>
|
|
{
|
|
'global' => ['DefaultPort', 'DesiredZone', 'EnableRouter'],
|
|
'adapter' => ['SeedingNetwork', 'ZoneList', 'DefaultZone',
|
|
'NetworkRangeLowerEnd', 'NetworkRangeUpperEnd'],
|
|
},
|
|
|
|
'MS_MSClient' =>
|
|
{
|
|
'global' => ['BrowseDomains', 'NameServiceNetworkAddress',
|
|
'NameServiceProtocol', 'RPCSupportForBanyan',
|
|
'Browser.Parameters', 'NetLogon.Parameters',
|
|
'LanaPath', 'LanaCode',
|
|
# find out if the following are still valid
|
|
'DefaultSecurityProvider'],
|
|
'adapter' => [],
|
|
},
|
|
|
|
|
|
'MS_NWClient' =>
|
|
{
|
|
'global' => ['PreferredServer', 'DefaultTree',
|
|
'DefaultContext', 'LogonScript',
|
|
'NWCWorkstation.Parameters'],
|
|
'adapter' => [],
|
|
},
|
|
|
|
|
|
'MS_Server' =>
|
|
{
|
|
'global' => ['Optimization', 'BroadcastsToLanman2Clients',
|
|
'LanmanServer.Parameters', 'LanmanServer.Shares',
|
|
'LanmanServer.AutotunedParameters'],
|
|
'adapter' => [],
|
|
},
|
|
|
|
|
|
'MS_RAS' =>
|
|
{
|
|
'global' => ['ForceEncryptedPassword', 'ForceEncryptedData',
|
|
'Multilink', 'DialinProtocols',
|
|
'NetBEUIClientAccess', 'TcpIpClientAccess',
|
|
'UseDHCP', 'IpPoolStart', 'IpPoolMask',
|
|
'ClientCanRequestIPAddress', 'IPXClientAccess',
|
|
'AutomaticNetworkNumbers', 'NetworkNumberFrom',
|
|
'AssignSameNetworkNumber',
|
|
'ClientsCanRequestIpxNodeNumber'],
|
|
'adapter' => [],
|
|
},
|
|
};
|
|
|
|
my @afile_keywords =
|
|
('', 'AdapterSections', 'SpecificTo');
|
|
|
|
|
|
my $component;
|
|
|
|
foreach $component (keys %$params)
|
|
{
|
|
my ($global_params, $adapter_params);
|
|
my @adapter_params_in_global_section;
|
|
my @global_params_in_adapter_sections;
|
|
my ($params_section, $adapter_section);
|
|
my @adapter_sections;
|
|
my @adapter_and_global_params;
|
|
|
|
$global_params = $$params{$component}{'global'};
|
|
$adapter_params = $$params{$component}{'adapter'};
|
|
@adapter_and_global_params = (@$adapter_params, @$global_params);
|
|
|
|
|
|
if ($params_section = get_params_section($component))
|
|
{
|
|
if (@adapter_params_in_global_section =
|
|
grep { exists($inf{$params_section}{lc($_)}); } @$adapter_params)
|
|
{
|
|
show_error($params_section, '', "this section can only have global parameters of $component. The following adapter specific parameters are incorrectly listed in this section: " . join(", ", @adapter_params_in_global_section));
|
|
}
|
|
|
|
if (@adapter_sections = get_adapter_sections($component))
|
|
{
|
|
foreach $adapter_section (@adapter_sections)
|
|
{
|
|
check_for_unknown_keys($component, $adapter_section,
|
|
\@adapter_and_global_params,
|
|
\@obsolete_keywords_non_adapter);
|
|
|
|
if (@global_params_in_adapter_sections =
|
|
grep { exists($inf{$adapter_section}{lc($_)}) } @$global_params)
|
|
{
|
|
show_error($adapter_section, '', "this section can only have adapter specific parameters of $component. The following global parameters are incorrectly listed in this section: " . join(", ", @global_params_in_adapter_sections));
|
|
}
|
|
}
|
|
}
|
|
|
|
check_for_obsolete_keys($params_section, \@obsolete_keywords_non_adapter);
|
|
check_for_unknown_keys($component, $params_section,
|
|
\@adapter_and_global_params,
|
|
\@obsolete_keywords_non_adapter);
|
|
}
|
|
}
|
|
|
|
|
|
sub get_params_section
|
|
{
|
|
my @net_sections = ('NetProtocols', 'NetServices', 'NetClients');
|
|
my $component = lc($_[0]);
|
|
my ($params_section, $section, $tsection);
|
|
|
|
foreach $section (@net_sections)
|
|
{
|
|
if (exists($inf{$section}{$component}))
|
|
{
|
|
$tsection = $inf{$section}{$component};
|
|
if (exists($inf{$tsection}))
|
|
{
|
|
$params_section = $tsection;
|
|
}
|
|
last;
|
|
}
|
|
}
|
|
|
|
return $params_section;
|
|
}
|
|
|
|
sub get_adapter_sections
|
|
{
|
|
my $component = lc($_[0]);
|
|
my $params_section;
|
|
my @adapter_sections;
|
|
|
|
if ($params_section = get_params_section($component))
|
|
{
|
|
@adapter_sections =
|
|
split(/,/, $inf{$params_section}{'adaptersections'});
|
|
}
|
|
|
|
return @adapter_sections;
|
|
}
|
|
|
|
sub check_for_unknown_keys
|
|
{
|
|
my $component = $_[0];
|
|
my $params_section = $_[1];
|
|
my @valid_keys = @{$_[2]};
|
|
my @ignore_keys = @{$_[3]};
|
|
my @all_valid_keys = (@afile_keywords, @valid_keys);
|
|
my @keys_in_section;
|
|
my @unknown_keys;
|
|
|
|
@keys_in_section = keys(%{$inf{$params_section}});
|
|
if (@unknown_keys =
|
|
grep { !is_in_list($_, \@all_valid_keys) &&
|
|
!is_in_list($_, \@ignore_keys) } @keys_in_section)
|
|
{
|
|
show_error($params_section, '', "has the following keys that are not valid for '$component': " . join(", ", @unknown_keys));
|
|
}
|
|
}
|
|
|
|
sub check_for_obsolete_keys
|
|
{
|
|
my $obsolete_keyword;
|
|
my $params_section = $_[0];
|
|
my @obsolete_keywords = @{$_[1]};
|
|
|
|
foreach $obsolete_keyword (@obsolete_keywords)
|
|
{
|
|
if (exists($inf{$params_section}{$obsolete_keyword}))
|
|
{
|
|
show_error($params_section, $obsolete_keyword, "this keyword is now obsolete");
|
|
}
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# helper stuff
|
|
#
|
|
|
|
my %inf_line_num;
|
|
|
|
sub store_key
|
|
{
|
|
# my $section = lc($_[0]);
|
|
my $section = $_[0];
|
|
my $key = lc($_[1]);
|
|
my $value = $_[2];
|
|
|
|
# print "$.: [$section].$key = $value\n";
|
|
$inf{$section}{$key} = $value;
|
|
$inf_line_num{$section}{$key} = $.;
|
|
}
|
|
|
|
sub show_error
|
|
{
|
|
my $section = $_[0];
|
|
my $key = lc($_[1]);
|
|
my $msg = $_[2];
|
|
my $line_num;
|
|
|
|
|
|
if (defined($line_num = $inf_line_num{$section}{$key}))
|
|
{
|
|
print "$CurrentFile($line_num) : [$section]",
|
|
$key ne "" ? ".$key : " : " : ", "$msg\n";
|
|
}
|
|
else
|
|
{
|
|
print "$CurrentFile : $msg\n";
|
|
}
|
|
}
|
|
|
|
sub is_in_list
|
|
{
|
|
my $item = lc($_[0]);
|
|
my @item_list = @{$_[1]};
|
|
my $t_item;
|
|
|
|
foreach $t_item (@item_list)
|
|
{
|
|
if (lc($t_item) eq $item)
|
|
{
|
|
return 1;
|
|
}
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
sub strip_quotes
|
|
{
|
|
my ($item, $b, $e);
|
|
|
|
foreach $item (@_)
|
|
{
|
|
$b = index($item, "\"");
|
|
$e = rindex($item, "\"");
|
|
if (($b >= 0) && ($b != $e))
|
|
{
|
|
$item = substr($item, $b+1, $e-$b-1);
|
|
}
|
|
}
|
|
@_;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# misc debug helper stuff
|
|
#
|
|
sub pl
|
|
{
|
|
print "Items: ", join(", ", @_), "\n";
|
|
};
|