#+--------------------------------------------------------------------------- # # Microsoft Windows # Copyright (C) Microsoft Corporation, 1998. # # File: N E T W I Z . P L # # Contents: Perl script to perform the following tasks # - generate the networking portion of an answerfile # - force delete a component from registry # - check net registry for consistency # # Notes: This script will work only on NT5. # # Author: kumarp 30-August-98 # #---------------------------------------------------------------------------- #---------------------------------------------------------------------------- # Known issues: # - None at present # # Future enhancements: # - add more comments # - combine chkaf.pl functionality into this # - generate [NetBindings] section # - InfId==* in case of single adapter (also InfIdReal) #---------------------------------------------------------------------------- use Win32; use Win32::Registry; use Getopt::Long; # ----------------------------------------------------------------- # Constants # my $NCF_VIRTUAL = 0x1; my $NCF_SOFTWARE_ENUMERATED = 0x2; my $NCF_PHYSICAL = 0x4; my $NCF_HIDDEN = 0x8; my $NCF_NO_SERVICE = 0x10; my $NCF_NOT_USER_REMOVABLE = 0x20; my $NCF_HAS_UI = 0x80; my $NCF_MODEM = 0x100; my $NCF_FILTER = 0x400; my $NCF_DONTEXPOSELOWER = 0x1000; my $NCF_HIDE_BINDING = 0x2000; my $NCF_FORCE_TDI_NOTIFY = 0x4000; my $NCF_FORCE_NDIS_NOTIFY = 0x8000; my $NCF_FORCE_SCM_NOTIFY = 0x10000; my $NCF_FIXED_BINDING = 0x2000; #my $rp_network='nn'; my $rp_network = 'SYSTEM\\CurrentControlSet\\Control\\Network'; my $rk_network; #my $rp_services = 'ss'; my $rp_services = 'SYSTEM\\CurrentControlSet\\Services'; my $rk_services; # # net guids # my $guid_net = '{4D36E972-E325-11CE-BFC1-08002BE10318}'; my $guid_net_protocols = '{4D36E975-E325-11CE-BFC1-08002BE10318}'; my $guid_net_services = '{4D36E974-E325-11CE-BFC1-08002BE10318}'; my $guid_net_clients = '{4D36E973-E325-11CE-BFC1-08002BE10318}'; # # regular expressions # my $regex_infid = '[a-zA-Z_]+'; my $regex_guid = "{[0-9a-fA-F---]+}"; my $regex_service_name = '[a-zA-Z]+'; my $regex_special_chars= '[\s=%]'; # ----------------------------------------------------------------- # Globals # my @installed_services; my %adapters; my %protocols; my %clients; my %services; my $comp_map = { 'NetAdapters' => [$guid_net, \%adapters], 'NetProtocols' => [$guid_net_protocols, \%protocols], 'NetClients' => [$guid_net_clients, \%clients], 'NetServices' => [$guid_net_services, \%services], }; $HKEY_LOCAL_MACHINE->Open($rp_network, $rk_network) || die "could not open $rp_network: $!"; $HKEY_LOCAL_MACHINE->Open($rp_services, $rk_services) || die "could not open $rp_services: $!"; $rk_services->GetKeys(\@installed_services); #my %tvalues; #my @tkeys; # # info about which parameters to read in from the registry # for a component or a set of components # my $regkeymap = { # --------------------------------------------- # Misc # 'NetAdapters' => [ \['PnpInstanceID', 'InfId'], \['Connection\\Name', 'ConnectionName'], ], 'NetComponentCommon' => [ \['ComponentId', 'InfId'], \['Description'], \['Ndi\\Service', 'Service'], \['Ndi\\CoServices', 'CoServices'], ], # --------------------------------------------- # Protocols # 'ms_tcpip' => [ \['Parameters\\EnableLMHOSTS'], \['Parameters\\EnableDNS'], \['SearchList'], \['Parameters\\UseDomainNameDevolution'], \['EnableSecurityFilters'], #?? \['ScopeID'], ], 'ms_tcpip.adapter' => [ \['Parameters\\Interfaces'], \['NameServer'], # DNSServerSearchOrder \['NameServerList'], # WinsServerList \['NetBiosOption'], #?? Option in spec Options in tcpaf.cpp ? \['DhcpClassId'], #?? only in spec, not in code ? \['Domain'], # DNSDomain \['EnableDHCP'], \['IPAddress'], \['SubnetMask'], \['DefaultGateway'], ], 'ms_nwipx' => [ \['Parameters\\VirtualNetworkNumber'], \['Parameters\\DedicatedRouter'], \['Parameters\\EnableWANRouter'], ], 'ms_nwipx.adapter' => [ \['Parameters\\Adapters'], #?? make sure that adapter-instance-guid is used under this key. the code in nwlnkipx.cpp mentions szBindName ? \['PktType'], \['NetworkNumber'] ], 'ms_appletalk' => [ \['Parameters\\DefaultPort'], \['Parameters\\DesiredZone'], \['Parameters\\EnableRouter'], ], 'ms_appletalk.adapter' => [ \['Parameters\\Adapters'], #?? make sure that adapter-instance-guid is used under this key. the code in atlkobj.cpp mentions AdapterId ? \['SeedingNetwork'], \['ZoneList'], \['DefaultZone'], \['NetworkRangeLowerEnd'], \['NetworkRangeUpperEnd'], ], 'ms_pptp' => [ \['Parameters\\NumberLineDevices'], ], # --------------------------------------------- # Clients # 'ms_msclient' => [ \['Parameters\\OtherDomains'], \['SOFTWARE\\Microsoft\\Rpc\\NameService\\NetworkAddress'], \['SOFTWARE\\Microsoft\\Rpc\\NameService\\Protocol'], \['RPCSupportForBanyan'], #?? complex case ], 'ms_nwclient' => [ \['Parameters\\DefaultLocation'], # PreferredServer \['Parameters\\DefaultScriptOptions'], #LogonScript ], # --------------------------------------------- # Services # 'ms_server' => [ \["Parameters\\Size"], \["Parameters\\Lmannounce"], ], # BUGBUG: ras components not done yet 'ms_ras' => [ \['ForceEncryptedPassword'], \['ForceEncryptedData'], \['Multilink'], \['DialinProtocols'], \['NetBEUIClientAccess'], \['TcpIpClientAccess'], \['UseDHCP'], \['IpPoolStart'], \['IpPoolMask'], \['ClientCanRequestIPAddress'], \['IPXClientAccess'], \['AutomaticNetworkNumbers'], \['NetworkNumberFrom'], \['AssignSameNetworkNumber'], \['ClientsCanRequestIpxNodeNumber'], ], }; # # enumerate over components and store keys specified in regkeymap # in the components info db # foreach $component_section (keys %{$comp_map}) { my $guid = $$comp_map{$component_section}[0]; my $components = $$comp_map{$component_section}[1]; if ($rk_network->Open($guid, $rk_components)) { @tkeys = (); if ($rk_components->GetKeys(\@tkeys)) { foreach $component (@tkeys) { if ($rk_components->Open($component, $rk_component)) { if ($guid eq $guid_net) { if ($rk_component->Open('Connection', $rk_conn)) { MapAndStoreKeys($components, $component, $rk_component, $component_section); $rk_conn->Close(); } } elsif (($tval = kQueryValue($rk_component, 'Characteristics')), !($tval & $NCF_HIDDEN)) { MapAndStoreKeys($components, $component, $rk_component, 'NetComponentCommon'); my $infid = $$components{$component}{'InfId'}; my $service = $$components{$component}{'Service'}; if ($rk_services->Open($service, $rk_service)) { MapAndStoreKeys($components, $component, $rk_service, $infid); MapAndStoreAdapterKeys($components, $component, $rk_service, $infid); } } $rk_component->Close(); } } } $rk_components->Close(); } } # # use info in regkeymap to map a value and then store it in components db # sub MapAndStoreKeys { my ($dbname, $component_instance, $rk, $component_name) = @_; foreach $item (@{$$regkeymap{$component_name}}) { # print "$$$item[0] --- $$$item[1]\n"; StoreKey($dbname, $component_instance, $rk, $$$item[0], $$$item[1]); } } # # use info in regkeymap to map an adapter specific value and then # store it in components db # sub MapAndStoreAdapterKeys { my ($dbname, $component_instance, $rk, $component_name) = @_; my @adapter_items = @{$$regkeymap{$component_name . '.adapter'}}; my ($rk_adapter_params_base, $rk_adapter_params); my $rp_adapter_params_base; if (@adapter_items) { my $rp_adapter_params_base = $${shift(@adapter_items)}[0]; if ($rk->Open($rp_adapter_params_base, $rk_adapter_params_base)) { foreach $adapter (keys %adapters) { if ($rk_adapter_params_base->Open($adapter, $rk_adapter_params)) { foreach $item (@adapter_items) { StoreKey($dbname, $component_name . '.adapter.' . $adapter, $rk_adapter_params, $$$item[0], $$$item[1]); } $rk_adapter_params->Close(); } } $rk_adapter_params_base->Close(); } } } # ----------------------------------------------------------------- # # Store a given key into components db # sub StoreKey { my ($dbname, $dbkey, $rk, $value, $key_name) = @_; my $tval; if (defined($key_name)) { $key_to_use = $key_name; } elsif (!SplitValue($value, $dummy, $key_to_use)) { $key_to_use = $value; } if ($value =~ /<($regex_service_name)>([^<>\s]+)/) { if ($1 eq 'HKLM') { $tval = kQueryValue($HKEY_LOCAL_MACHINE, $2); } elsif ($rk_services->Open($1, $rk_tservice)) { $tval = kQueryValue($rk_tservice, $2); $rk_tservice->Close(); } } else { $tval = kQueryValue($rk, $value); } if (defined($tval)) { # print "$key_to_use <= $tval\n"; $$dbname{$dbkey}{$key_to_use} = $tval; } } # # We need this function since Perl's QueryValue function has a bug # sub kQueryValue { my ($hkey, $key_name) = @_; my %tvalues; my $tindex; my ($value, $value_type, $subkey); if (SplitValue($key_name, $subkey, $key_name)) { if ($hkey->Open($subkey, $thkey)) { $thkey->GetValues(\%tvalues); $thkey->Close(); # print "$subkey + $key_name -> $tvalues{$key_name}[2]\n"; } } else { $hkey->GetValues(\%tvalues); } $value = $tvalues{$key_name}[2]; $value_type = $tvalues{$key_name}[1]; if ($value_type == 7) { my @vlist; @vlist = split(chr(0), $value); return \@vlist; } else { return $value; } } # # Split a path into end-item and remaining sub-path # sub SplitValue { my $tindex; if (($tindex = rindex($_[0], '\\')) > 0) { $_[1] = substr($_[0], 0, $tindex); $_[2] = substr($_[0], $tindex+1, 9999); return 1; } else { return 0; } } # ----------------------------------------------------------------- # Cleanup $rk_network->Close(); $rk_services->Close(); # ----------------------------------------------------------------- # ----------------------------------------------------------------- # answerfile generation # my %af; my $MAP_BOOL = 0x1; my $MAP_ARRAY = 0x2; my $MAP_TO_LIST = 0x4; my $AF_COND_ValueMatch = 0x10000; my $AF_COND_ShowIfEmpty = 0x20000; my $afmap = { # --------------------------------------------- # Misc # 'NetAdapters' => [ \['InfId'], \['ConnectionName'], ], # --------------------------------------------- # Protocols # 'ms_tcpip' => [ \['EnableDNS', 'DNS', $MAP_BOOL], \['SearchList', 'DNSSuffixSearchOrder', $MAP_TO_LIST], \['UseDomainNameDevolution', undef, $MAP_BOOL], \['EnableSecurityFilters', 'EnableSecurity', $MAP_BOOL], \['ScopeID'], \['EnableLMHOSTS', undef, $MAP_BOOL] ], 'ms_tcpip.adapter' => [ \['NameServer', 'DNSServerSearchOrder' ], \['WINS'], #?? dump as Yes if WinsServerList is non-empty \['NameServerList', 'WinsServerList' ], \['NetBiosOption' ], \['DhcpClassId' ], \['Domain', 'DNSDomain'], \['EnableDHCP', 'DHCP', $MAP_BOOL], \['IPAddress', undef, $MAP_TO_LIST | $AF_COND_ValueMatch, 'EnableDHCP', 0], \['SubnetMask', undef, $MAP_TO_LIST | $AF_COND_ValueMatch, 'EnableDHCP', 0], \['DefaultGateway', undef, $MAP_TO_LIST | $AF_COND_ValueMatch, 'EnableDHCP', 0], ], 'ms_nwipx' => [ \['VirtualNetworkNumber'], \['DedicatedRouter'], \['EnableWANRouter'], ], 'ms_nwipx.adapter' => [ \['PktType'], \['NetworkNumber'] ], 'ms_appletalk' => [ \['DefaultPort'], \['DesiredZone'], \['EnableRouter'], ], 'ms_appletalk.adapter' => [ \['SeedingNetwork'], \['ZoneList'], \['DefaultZone'], \['NetworkRangeLowerEnd'], \['NetworkRangeUpperEnd'], ], 'ms_pptp' => [ \['NumberLineDevices'], ], # --------------------------------------------- # Clients # 'ms_msclient' => [ \['OtherDomains', 'BrowseDomains', $MAP_TO_LIST], \['NetworkAddress', 'NameServiceNetworkAddress'], \['Protocol', 'NameServiceProtocol'], \['RPCSupportForBanyan'], ], 'ms_nwclient' => [ \['DefaultLocation', 'PreferredServer'], \['DefaultScriptOptions', 'LogonScript'], ], # --------------------------------------------- # Services # 'ms_server' => [ \['Size', 'Optimization', $MAP_ARRAY, 1, 4, 1, \['MinMemoryUsed', 'Balance', 'MaxThroughputForFileSharing', 'MaxThrouputForNetworkApps']], \['Lmannounce', 'BroadcastsToLanman2Clients', $MAP_BOOL], ], 'ms_ras' => [ \['ForceEncryptedPassword'], \['ForceEncryptedData'], \['Multilink'], \['DialinProtocols'], \['NetBEUIClientAccess'], \['TcpIpClientAccess'], \['UseDHCP'], \['IpPoolStart'], \['IpPoolMask'], \['ClientCanRequestIPAddress'], \['IPXClientAccess'], \['AutomaticNetworkNumbers'], \['NetworkNumberFrom'], \['AssignSameNetworkNumber'], \['ClientsCanRequestIpxNodeNumber'], ], }; my %adapter_map; my %adapter_sections_map; sub GenAnswerFile { AfAddSection('Networking'); my $cAdapter = 1; my ($adapter_name, $params_section); my $infid; foreach $adapter (keys %adapters) { $adapter_name = 'Adapter' . $cAdapter++; $params_section = AfParamsSectionName($adapter_name); AfAddKey('NetAdapters', $adapter_name, $params_section); #AfAddKey($params_section, 'InstanceGuid', $adapter); $adapter_map{$adapter} = $adapter_name; AfMapAndAddKeys(\%adapters, $adapter, 'NetAdapters', $params_section); } foreach $component_section (keys %{$comp_map}) { my $components = $$comp_map{$component_section}[1]; foreach $component (keys %{$components}) { if ($component =~ /($regex_infid)\.adapter\.($regex_guid)/) { my ($proto_infid, $afmap_index, $adapter_guid) = ($1, $1 . '.adapter', $2); my $adapter_name = $adapter_map{$adapter_guid}; $params_section = AfParamsSectionName($proto_infid) . ".$adapter_name"; my $tadapter_sections; $tadapter_sections = $adapter_sections_map{$proto_infid}; @$tadapter_sections = ($params_section, @$tadapter_sections); @adapter_sections_map{$proto_infid} = $tadapter_sections; AfAddKey($params_section, 'SpecificTo', $adapter_name); AfMapAndAddKeys($components, $component, $afmap_index, $params_section); } else { $infid = $$components{$component}{'InfId'}; $params_section = AfParamsSectionName($infid); if ($component_section ne 'NetAdapters') { AfAddKey($component_section, $infid, $params_section); } if (defined($$afmap{$infid})) { AfMapAndAddKeys($components, $component, $infid, $params_section); } } } } foreach $proto_infid (keys %adapter_sections_map) { $params_section = AfParamsSectionName($proto_infid); AfAddKey($params_section, 'AdapterSections', join(',', @{$adapter_sections_map{$proto_infid}})); } } sub AfMapAndAddKeys { my ($components_db, $component, $afmap_index, $section) = @_; my ($key_to_write, $key, $value); my $map_flag; my @afkeys = @{$$afmap{$afmap_index}}; foreach $afkey_item (@afkeys) { $key_to_write = defined($$$afkey_item[1]) ? $$$afkey_item[1] : $$$afkey_item[0]; $key = $$$afkey_item[0]; if (defined($value = $$components_db{$component}{$key})) { $map_flag = $$$afkey_item[2]; if ($map_flag & $MAP_ARRAY) { my $lower_limit = $$$afkey_item[3]; my $upper_limit = $$$afkey_item[4]; my $base_offset = $$$afkey_item[5]; my $value_map = $$$afkey_item[6]; if (($value >= $lower_limit) && ($value <= $upper_limit)) { $value = $$$value_map[$value - $base_offset]; } } elsif ($map_flag & $MAP_BOOL) { $value = $value ? 'Yes' : 'No'; } elsif ($map_flag & $MAP_TO_LIST) { $value = join(',', @{$value}); } my $af_can_write = 1; if ($map_flag & $AF_COND_ValueMatch) { my ($key_to_check, $value_to_match) = ($$$afkey_item[3], $$$afkey_item[4]); my $tval; $tval = $$components_db{$component}{$key_to_check}; if ($tval != $value_to_match) { $af_can_write = 0; } } if (($value eq '') && (!($map_flag & $AF_COND_ShowIfEmpty))) { $af_can_write = 0; } if ($af_can_write) { AfAddKey($section, $key_to_write, $value); } } } } sub AfParamsSectionName { return 'params.' . $_[0]; } sub AfAddSection { $af{$_[0]}{''} = '
'; } sub AfAddKey { $af{$_[0]}{$_[1]} = $_[2]; } sub WriteAnswerFile { my $af_handle = $_[0]; foreach $section (keys %af) { print $af_handle "\n[$section]\n"; foreach $key (keys %{$af{$section}}) { next if $key eq ""; $value = $af{$section}{$key}; if ($value =~ /$regex_special_chars/) { $value = '"' . $value . '"'; } print $af_handle "$key = $value\n"; } } } sub GenAndWriteAnswerFile { my $af_handle = $_[0]; GenAnswerFile(); WriteAnswerFile($af_handle); } sub ShowUsage { print <<'--usage-end--'; Usage: netwiz [-h|?] [-c] [-d ] [-g []] Options: -h|-? Show this help message -c Check network configuration for consistency -d Forcefully delete the specified component from the registry. Not recommended for the faint of heart. ("Don't try it at home" type operation) -g Generate the networking portion of AnswerFile that describes the current networking configuration. If a file name is not specified, dump to stdout. --usage-end-- } sub main { if ((grep {/[---\/][?h]/i} @ARGV) || ($ARGV[0] eq '') || !GetOptions('c', 'd=s', 'g:s') || (defined($opt_d) && ($opt_d eq ''))) { ShowUsage(); exit; } if ($opt_d) { GetConfirmationAndForceRemoveComponent($opt_d); } elsif (defined($opt_g)) { if ($opt_g eq '') { GenAndWriteAnswerFile(STDOUT); } else { open(AF_HANDLE, ">$opt_g") || die "Cannot open $opt_g: $!"; GenAndWriteAnswerFile(AF_HANDLE); close(AF_HANDLE); } } elsif ($opt_c) { CheckNetworkConfigConsistency(); } } main(); # ----------------------------------------------------------------- # Diagonostic stuff # sub LocateComponentById { my $infid = $_[0]; foreach $component_section (keys %{$comp_map}) { my $class_guid = $$comp_map{$component_section}[0]; my $components = $$comp_map{$component_section}[1]; foreach $component (keys %{$components}) { if ($$components{$component}{'InfId'} eq $infid) { return ($component, $class_guid); } } } return undef; } sub ForceRemoveComponent { my $infid = $_[0]; my ($comp_guid, $comp_class_guid); if (($comp_guid, $comp_class_guid) = LocateComponentById($infid)) { my $rp_class = "$rp_network\\$comp_class_guid"; my $rk_class; if ($HKEY_LOCAL_MACHINE->Open($rp_class, $rk_class)) { if ($ENV{'COMPUTERNAME'} =~ /(kumarp[19])/i) { print "Dont do this on $1!!\n"; exit; } if (RegDeleteKeyTree($rk_class, $comp_guid)) { print "Deleted: HKLM\\$rp_class\\$comp_guid\n"; } else { print "Error deleting key: HKLM\\$rp_class\\$comp_guid: $!\n"; } $rk_class->Close(); } } } sub GetConfirmationAndForceRemoveComponent { my $infid = $_[0]; if (GetConfirmation("Are you sure you want to forcefully remove '$infid'")) { ForceRemoveComponent($infid); } } sub RegDeleteKeyTree { my ($rk, $subkey) = @_; my $rk_subkey; my $result = 1; if ($result = $rk->Open($subkey, $rk_subkey)) { my $tval; my %tvals; if ($result = $rk_subkey->GetValues(\%tvals)) { foreach $tval (keys %tvals) { # print "deleting $subkey\\$tval...\n"; last if (!$rk_subkey->DeleteValue($tval)); } my $tkey; my @tkeys; if ($rk_subkey->GetKeys(\@tkeys)) { foreach $tkey (@tkeys) { last if (!($result = RegDeleteKeyTree($rk_subkey, $tkey))); } } } $rk_subkey->Close(); if ($result) { # print "deleting $subkey...\n"; $result = $rk->DeleteKey($subkey); } } return $result; } sub CheckNetworkConfigConsistency { print "Checking services...\n"; CheckCoServices(); print "...done\n"; } # # - check that services listed using CoServices key are actually installed. # sub CheckCoServices { foreach $component_class ('NetProtocols', 'NetServices', 'NetClients') { my $components = $$comp_map{$component_class}[1]; foreach $component (keys %{$components}) { my @coservices; my @coservices_not_installed; my $infid = $$components{$component}{'InfId'}; next if $infid eq ''; # print "$infid..."; @coservices = @{$$components{$component}{'CoServices'}}; @coservices_not_installed = SubtractLists(\@coservices, \@installed_services); if (scalar @coservices_not_installed) { print("$infid: the following service(s) are required for successful operation of this component, but do not seem to be installed: ", join(', ', @coservices_not_installed)); } } } } sub SubtractLists { my ($list1, $list2) = @_; my @result; @result = grep { !IsInList($_, $list2) } @$list1; return @result; } sub GetCommonItems { my ($list1, $list2) = @_; my @common_items; @common_items = grep { IsInList($_, $list2) } @$list1; return @common_items; } sub IsInList { my $item = lc($_[0]); my @item_list = @{$_[1]}; return scalar grep { lc($_) eq $item } @item_list; } sub IsInList1 { 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; } # ----------------------------------------------------------------- # Misc helper stuff # sub GetConfirmation { my $question = $_[0]; my $answer; while (!($answer =~ /[yn]/i)) { print "$question ? [y/n]\n"; $answer = ; } return $answer =~ /[y]/i; } # ----------------------------------------------------------------- # Misc debug helper stuff # sub pl { print "Items: ", join(", ", @_), "\n"; }; sub p { print join(", ", @_), "\n"; }; # -----------------------------------------------------------------