Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1041 lines
24 KiB

  1. #+---------------------------------------------------------------------------
  2. #
  3. # Microsoft Windows
  4. # Copyright (C) Microsoft Corporation, 1998.
  5. #
  6. # File: N E T W I Z . P L
  7. #
  8. # Contents: Perl script to perform the following tasks
  9. # - generate the networking portion of an answerfile
  10. # - force delete a component from registry
  11. # - check net registry for consistency
  12. #
  13. # Notes: This script will work only on NT5.
  14. #
  15. # Author: kumarp 30-August-98
  16. #
  17. #----------------------------------------------------------------------------
  18. #----------------------------------------------------------------------------
  19. # Known issues:
  20. # - None at present
  21. #
  22. # Future enhancements:
  23. # - add more comments
  24. # - combine chkaf.pl functionality into this
  25. # - generate [NetBindings] section
  26. # - InfId==* in case of single adapter (also InfIdReal)
  27. #----------------------------------------------------------------------------
  28. use Win32;
  29. use Win32::Registry;
  30. use Getopt::Long;
  31. # -----------------------------------------------------------------
  32. # Constants
  33. #
  34. my $NCF_VIRTUAL = 0x1;
  35. my $NCF_SOFTWARE_ENUMERATED = 0x2;
  36. my $NCF_PHYSICAL = 0x4;
  37. my $NCF_HIDDEN = 0x8;
  38. my $NCF_NO_SERVICE = 0x10;
  39. my $NCF_NOT_USER_REMOVABLE = 0x20;
  40. my $NCF_HAS_UI = 0x80;
  41. my $NCF_MODEM = 0x100;
  42. my $NCF_FILTER = 0x400;
  43. my $NCF_DONTEXPOSELOWER = 0x1000;
  44. my $NCF_HIDE_BINDING = 0x2000;
  45. my $NCF_FORCE_TDI_NOTIFY = 0x4000;
  46. my $NCF_FORCE_NDIS_NOTIFY = 0x8000;
  47. my $NCF_FORCE_SCM_NOTIFY = 0x10000;
  48. my $NCF_FIXED_BINDING = 0x2000;
  49. #my $rp_network='nn';
  50. my $rp_network = 'SYSTEM\\CurrentControlSet\\Control\\Network';
  51. my $rk_network;
  52. #my $rp_services = 'ss';
  53. my $rp_services = 'SYSTEM\\CurrentControlSet\\Services';
  54. my $rk_services;
  55. #
  56. # net guids
  57. #
  58. my $guid_net = '{4D36E972-E325-11CE-BFC1-08002BE10318}';
  59. my $guid_net_protocols = '{4D36E975-E325-11CE-BFC1-08002BE10318}';
  60. my $guid_net_services = '{4D36E974-E325-11CE-BFC1-08002BE10318}';
  61. my $guid_net_clients = '{4D36E973-E325-11CE-BFC1-08002BE10318}';
  62. #
  63. # regular expressions
  64. #
  65. my $regex_infid = '[a-zA-Z_]+';
  66. my $regex_guid = "{[0-9a-fA-F---]+}";
  67. my $regex_service_name = '[a-zA-Z]+';
  68. my $regex_special_chars= '[\s=%]';
  69. # -----------------------------------------------------------------
  70. # Globals
  71. #
  72. my @installed_services;
  73. my %adapters;
  74. my %protocols;
  75. my %clients;
  76. my %services;
  77. my $comp_map =
  78. {
  79. 'NetAdapters' => [$guid_net, \%adapters],
  80. 'NetProtocols' => [$guid_net_protocols, \%protocols],
  81. 'NetClients' => [$guid_net_clients, \%clients],
  82. 'NetServices' => [$guid_net_services, \%services],
  83. };
  84. $HKEY_LOCAL_MACHINE->Open($rp_network, $rk_network)
  85. || die "could not open $rp_network: $!";
  86. $HKEY_LOCAL_MACHINE->Open($rp_services, $rk_services)
  87. || die "could not open $rp_services: $!";
  88. $rk_services->GetKeys(\@installed_services);
  89. #my %tvalues;
  90. #my @tkeys;
  91. #
  92. # info about which parameters to read in from the registry
  93. # for a component or a set of components
  94. #
  95. my $regkeymap =
  96. {
  97. # ---------------------------------------------
  98. # Misc
  99. #
  100. 'NetAdapters' =>
  101. [
  102. \['PnpInstanceID', 'InfId'],
  103. \['Connection\\Name', 'ConnectionName'],
  104. ],
  105. 'NetComponentCommon' =>
  106. [
  107. \['ComponentId', 'InfId'],
  108. \['Description'],
  109. \['Ndi\\Service', 'Service'],
  110. \['Ndi\\CoServices', 'CoServices'],
  111. ],
  112. # ---------------------------------------------
  113. # Protocols
  114. #
  115. 'ms_tcpip' =>
  116. [
  117. \['<NetBT>Parameters\\EnableLMHOSTS'],
  118. \['<NetBT>Parameters\\EnableDNS'],
  119. \['SearchList'],
  120. \['Parameters\\UseDomainNameDevolution'],
  121. \['EnableSecurityFilters'], #??
  122. \['ScopeID'],
  123. ],
  124. 'ms_tcpip.adapter' =>
  125. [
  126. \['Parameters\\Interfaces'],
  127. \['NameServer'], # DNSServerSearchOrder
  128. \['NameServerList'], # WinsServerList
  129. \['NetBiosOption'], #?? Option in spec Options in tcpaf.cpp ?
  130. \['DhcpClassId'], #?? only in spec, not in code ?
  131. \['Domain'], # DNSDomain
  132. \['EnableDHCP'],
  133. \['IPAddress'],
  134. \['SubnetMask'],
  135. \['DefaultGateway'],
  136. ],
  137. 'ms_nwipx' =>
  138. [
  139. \['Parameters\\VirtualNetworkNumber'],
  140. \['Parameters\\DedicatedRouter'],
  141. \['Parameters\\EnableWANRouter'],
  142. ],
  143. 'ms_nwipx.adapter' =>
  144. [
  145. \['Parameters\\Adapters'], #?? make sure that adapter-instance-guid is used under this key. the code in nwlnkipx.cpp mentions szBindName ?
  146. \['PktType'],
  147. \['NetworkNumber']
  148. ],
  149. 'ms_appletalk' =>
  150. [
  151. \['Parameters\\DefaultPort'],
  152. \['Parameters\\DesiredZone'],
  153. \['Parameters\\EnableRouter'],
  154. ],
  155. 'ms_appletalk.adapter' =>
  156. [
  157. \['Parameters\\Adapters'], #?? make sure that adapter-instance-guid is used under this key. the code in atlkobj.cpp mentions AdapterId ?
  158. \['SeedingNetwork'],
  159. \['ZoneList'],
  160. \['DefaultZone'],
  161. \['NetworkRangeLowerEnd'],
  162. \['NetworkRangeUpperEnd'],
  163. ],
  164. 'ms_pptp' =>
  165. [
  166. \['Parameters\\NumberLineDevices'],
  167. ],
  168. # ---------------------------------------------
  169. # Clients
  170. #
  171. 'ms_msclient' =>
  172. [
  173. \['Parameters\\OtherDomains'],
  174. \['<HKLM>SOFTWARE\\Microsoft\\Rpc\\NameService\\NetworkAddress'],
  175. \['<HKLM>SOFTWARE\\Microsoft\\Rpc\\NameService\\Protocol'],
  176. \['RPCSupportForBanyan'], #?? complex case
  177. ],
  178. 'ms_nwclient' =>
  179. [
  180. \['Parameters\\DefaultLocation'], # PreferredServer
  181. \['Parameters\\DefaultScriptOptions'], #LogonScript
  182. ],
  183. # ---------------------------------------------
  184. # Services
  185. #
  186. 'ms_server' =>
  187. [
  188. \["Parameters\\Size"],
  189. \["Parameters\\Lmannounce"],
  190. ],
  191. # BUGBUG: ras components not done yet
  192. 'ms_ras' =>
  193. [
  194. \['ForceEncryptedPassword'],
  195. \['ForceEncryptedData'],
  196. \['Multilink'],
  197. \['DialinProtocols'],
  198. \['NetBEUIClientAccess'],
  199. \['TcpIpClientAccess'],
  200. \['UseDHCP'],
  201. \['IpPoolStart'],
  202. \['IpPoolMask'],
  203. \['ClientCanRequestIPAddress'],
  204. \['IPXClientAccess'],
  205. \['AutomaticNetworkNumbers'],
  206. \['NetworkNumberFrom'],
  207. \['AssignSameNetworkNumber'],
  208. \['ClientsCanRequestIpxNodeNumber'],
  209. ],
  210. };
  211. #
  212. # enumerate over components and store keys specified in regkeymap
  213. # in the components info db
  214. #
  215. foreach $component_section (keys %{$comp_map})
  216. {
  217. my $guid = $$comp_map{$component_section}[0];
  218. my $components = $$comp_map{$component_section}[1];
  219. if ($rk_network->Open($guid, $rk_components))
  220. {
  221. @tkeys = ();
  222. if ($rk_components->GetKeys(\@tkeys))
  223. {
  224. foreach $component (@tkeys)
  225. {
  226. if ($rk_components->Open($component, $rk_component))
  227. {
  228. if ($guid eq $guid_net)
  229. {
  230. if ($rk_component->Open('Connection', $rk_conn))
  231. {
  232. MapAndStoreKeys($components, $component,
  233. $rk_component, $component_section);
  234. $rk_conn->Close();
  235. }
  236. }
  237. elsif (($tval = kQueryValue($rk_component,
  238. 'Characteristics')),
  239. !($tval & $NCF_HIDDEN))
  240. {
  241. MapAndStoreKeys($components, $component,
  242. $rk_component, 'NetComponentCommon');
  243. my $infid = $$components{$component}{'InfId'};
  244. my $service = $$components{$component}{'Service'};
  245. if ($rk_services->Open($service, $rk_service))
  246. {
  247. MapAndStoreKeys($components, $component,
  248. $rk_service, $infid);
  249. MapAndStoreAdapterKeys($components, $component,
  250. $rk_service, $infid);
  251. }
  252. }
  253. $rk_component->Close();
  254. }
  255. }
  256. }
  257. $rk_components->Close();
  258. }
  259. }
  260. #
  261. # use info in regkeymap to map a value and then store it in components db
  262. #
  263. sub MapAndStoreKeys
  264. {
  265. my ($dbname, $component_instance, $rk, $component_name) = @_;
  266. foreach $item (@{$$regkeymap{$component_name}})
  267. {
  268. # print "$$$item[0] --- $$$item[1]\n";
  269. StoreKey($dbname, $component_instance, $rk,
  270. $$$item[0], $$$item[1]);
  271. }
  272. }
  273. #
  274. # use info in regkeymap to map an adapter specific value and then
  275. # store it in components db
  276. #
  277. sub MapAndStoreAdapterKeys
  278. {
  279. my ($dbname, $component_instance, $rk, $component_name) = @_;
  280. my @adapter_items = @{$$regkeymap{$component_name . '.adapter'}};
  281. my ($rk_adapter_params_base, $rk_adapter_params);
  282. my $rp_adapter_params_base;
  283. if (@adapter_items)
  284. {
  285. my $rp_adapter_params_base = $${shift(@adapter_items)}[0];
  286. if ($rk->Open($rp_adapter_params_base, $rk_adapter_params_base))
  287. {
  288. foreach $adapter (keys %adapters)
  289. {
  290. if ($rk_adapter_params_base->Open($adapter, $rk_adapter_params))
  291. {
  292. foreach $item (@adapter_items)
  293. {
  294. StoreKey($dbname, $component_name . '.adapter.' . $adapter,
  295. $rk_adapter_params, $$$item[0], $$$item[1]);
  296. }
  297. $rk_adapter_params->Close();
  298. }
  299. }
  300. $rk_adapter_params_base->Close();
  301. }
  302. }
  303. }
  304. # -----------------------------------------------------------------
  305. #
  306. # Store a given key into components db
  307. #
  308. sub StoreKey
  309. {
  310. my ($dbname, $dbkey, $rk, $value, $key_name) = @_;
  311. my $tval;
  312. if (defined($key_name))
  313. {
  314. $key_to_use = $key_name;
  315. }
  316. elsif (!SplitValue($value, $dummy, $key_to_use))
  317. {
  318. $key_to_use = $value;
  319. }
  320. if ($value =~ /<($regex_service_name)>([^<>\s]+)/)
  321. {
  322. if ($1 eq 'HKLM')
  323. {
  324. $tval = kQueryValue($HKEY_LOCAL_MACHINE, $2);
  325. }
  326. elsif ($rk_services->Open($1, $rk_tservice))
  327. {
  328. $tval = kQueryValue($rk_tservice, $2);
  329. $rk_tservice->Close();
  330. }
  331. }
  332. else
  333. {
  334. $tval = kQueryValue($rk, $value);
  335. }
  336. if (defined($tval))
  337. {
  338. # print "$key_to_use <= $tval\n";
  339. $$dbname{$dbkey}{$key_to_use} = $tval;
  340. }
  341. }
  342. #
  343. # We need this function since Perl's QueryValue function has a bug
  344. #
  345. sub kQueryValue
  346. {
  347. my ($hkey, $key_name) = @_;
  348. my %tvalues;
  349. my $tindex;
  350. my ($value, $value_type, $subkey);
  351. if (SplitValue($key_name, $subkey, $key_name))
  352. {
  353. if ($hkey->Open($subkey, $thkey))
  354. {
  355. $thkey->GetValues(\%tvalues);
  356. $thkey->Close();
  357. # print "$subkey + $key_name -> $tvalues{$key_name}[2]\n";
  358. }
  359. }
  360. else
  361. {
  362. $hkey->GetValues(\%tvalues);
  363. }
  364. $value = $tvalues{$key_name}[2];
  365. $value_type = $tvalues{$key_name}[1];
  366. if ($value_type == 7)
  367. {
  368. my @vlist;
  369. @vlist = split(chr(0), $value);
  370. return \@vlist;
  371. }
  372. else
  373. {
  374. return $value;
  375. }
  376. }
  377. #
  378. # Split a path into end-item and remaining sub-path
  379. #
  380. sub SplitValue
  381. {
  382. my $tindex;
  383. if (($tindex = rindex($_[0], '\\')) > 0)
  384. {
  385. $_[1] = substr($_[0], 0, $tindex);
  386. $_[2] = substr($_[0], $tindex+1, 9999);
  387. return 1;
  388. }
  389. else
  390. {
  391. return 0;
  392. }
  393. }
  394. # -----------------------------------------------------------------
  395. # Cleanup
  396. $rk_network->Close();
  397. $rk_services->Close();
  398. # -----------------------------------------------------------------
  399. # -----------------------------------------------------------------
  400. # answerfile generation
  401. #
  402. my %af;
  403. my $MAP_BOOL = 0x1;
  404. my $MAP_ARRAY = 0x2;
  405. my $MAP_TO_LIST = 0x4;
  406. my $AF_COND_ValueMatch = 0x10000;
  407. my $AF_COND_ShowIfEmpty = 0x20000;
  408. my $afmap =
  409. {
  410. # ---------------------------------------------
  411. # Misc
  412. #
  413. 'NetAdapters' =>
  414. [
  415. \['InfId'],
  416. \['ConnectionName'],
  417. ],
  418. # ---------------------------------------------
  419. # Protocols
  420. #
  421. 'ms_tcpip' =>
  422. [
  423. \['EnableDNS', 'DNS', $MAP_BOOL],
  424. \['SearchList', 'DNSSuffixSearchOrder', $MAP_TO_LIST],
  425. \['UseDomainNameDevolution', undef, $MAP_BOOL],
  426. \['EnableSecurityFilters', 'EnableSecurity', $MAP_BOOL],
  427. \['ScopeID'],
  428. \['EnableLMHOSTS', undef, $MAP_BOOL]
  429. ],
  430. 'ms_tcpip.adapter' =>
  431. [
  432. \['NameServer', 'DNSServerSearchOrder' ],
  433. \['WINS'], #?? dump as Yes if WinsServerList is non-empty
  434. \['NameServerList', 'WinsServerList' ],
  435. \['NetBiosOption' ],
  436. \['DhcpClassId' ],
  437. \['Domain', 'DNSDomain'],
  438. \['EnableDHCP', 'DHCP', $MAP_BOOL],
  439. \['IPAddress', undef, $MAP_TO_LIST | $AF_COND_ValueMatch, 'EnableDHCP', 0],
  440. \['SubnetMask', undef, $MAP_TO_LIST | $AF_COND_ValueMatch, 'EnableDHCP', 0],
  441. \['DefaultGateway', undef, $MAP_TO_LIST | $AF_COND_ValueMatch, 'EnableDHCP', 0],
  442. ],
  443. 'ms_nwipx' =>
  444. [
  445. \['VirtualNetworkNumber'],
  446. \['DedicatedRouter'],
  447. \['EnableWANRouter'],
  448. ],
  449. 'ms_nwipx.adapter' =>
  450. [
  451. \['PktType'],
  452. \['NetworkNumber']
  453. ],
  454. 'ms_appletalk' =>
  455. [
  456. \['DefaultPort'],
  457. \['DesiredZone'],
  458. \['EnableRouter'],
  459. ],
  460. 'ms_appletalk.adapter' =>
  461. [
  462. \['SeedingNetwork'],
  463. \['ZoneList'],
  464. \['DefaultZone'],
  465. \['NetworkRangeLowerEnd'],
  466. \['NetworkRangeUpperEnd'],
  467. ],
  468. 'ms_pptp' =>
  469. [
  470. \['NumberLineDevices'],
  471. ],
  472. # ---------------------------------------------
  473. # Clients
  474. #
  475. 'ms_msclient' =>
  476. [
  477. \['OtherDomains', 'BrowseDomains', $MAP_TO_LIST],
  478. \['NetworkAddress', 'NameServiceNetworkAddress'],
  479. \['Protocol', 'NameServiceProtocol'],
  480. \['RPCSupportForBanyan'],
  481. ],
  482. 'ms_nwclient' =>
  483. [
  484. \['DefaultLocation', 'PreferredServer'],
  485. \['DefaultScriptOptions', 'LogonScript'],
  486. ],
  487. # ---------------------------------------------
  488. # Services
  489. #
  490. 'ms_server' =>
  491. [
  492. \['Size', 'Optimization', $MAP_ARRAY, 1, 4, 1,
  493. \['MinMemoryUsed', 'Balance',
  494. 'MaxThroughputForFileSharing', 'MaxThrouputForNetworkApps']],
  495. \['Lmannounce', 'BroadcastsToLanman2Clients', $MAP_BOOL],
  496. ],
  497. 'ms_ras' =>
  498. [
  499. \['ForceEncryptedPassword'],
  500. \['ForceEncryptedData'],
  501. \['Multilink'],
  502. \['DialinProtocols'],
  503. \['NetBEUIClientAccess'],
  504. \['TcpIpClientAccess'],
  505. \['UseDHCP'],
  506. \['IpPoolStart'],
  507. \['IpPoolMask'],
  508. \['ClientCanRequestIPAddress'],
  509. \['IPXClientAccess'],
  510. \['AutomaticNetworkNumbers'],
  511. \['NetworkNumberFrom'],
  512. \['AssignSameNetworkNumber'],
  513. \['ClientsCanRequestIpxNodeNumber'],
  514. ],
  515. };
  516. my %adapter_map;
  517. my %adapter_sections_map;
  518. sub GenAnswerFile
  519. {
  520. AfAddSection('Networking');
  521. my $cAdapter = 1;
  522. my ($adapter_name, $params_section);
  523. my $infid;
  524. foreach $adapter (keys %adapters)
  525. {
  526. $adapter_name = 'Adapter' . $cAdapter++;
  527. $params_section = AfParamsSectionName($adapter_name);
  528. AfAddKey('NetAdapters', $adapter_name, $params_section);
  529. #AfAddKey($params_section, 'InstanceGuid', $adapter);
  530. $adapter_map{$adapter} = $adapter_name;
  531. AfMapAndAddKeys(\%adapters, $adapter, 'NetAdapters',
  532. $params_section);
  533. }
  534. foreach $component_section (keys %{$comp_map})
  535. {
  536. my $components = $$comp_map{$component_section}[1];
  537. foreach $component (keys %{$components})
  538. {
  539. if ($component =~ /($regex_infid)\.adapter\.($regex_guid)/)
  540. {
  541. my ($proto_infid, $afmap_index, $adapter_guid)
  542. = ($1, $1 . '.adapter', $2);
  543. my $adapter_name = $adapter_map{$adapter_guid};
  544. $params_section = AfParamsSectionName($proto_infid) .
  545. ".$adapter_name";
  546. my $tadapter_sections;
  547. $tadapter_sections = $adapter_sections_map{$proto_infid};
  548. @$tadapter_sections = ($params_section, @$tadapter_sections);
  549. @adapter_sections_map{$proto_infid} = $tadapter_sections;
  550. AfAddKey($params_section, 'SpecificTo', $adapter_name);
  551. AfMapAndAddKeys($components, $component,
  552. $afmap_index, $params_section);
  553. }
  554. else
  555. {
  556. $infid = $$components{$component}{'InfId'};
  557. $params_section = AfParamsSectionName($infid);
  558. if ($component_section ne 'NetAdapters')
  559. {
  560. AfAddKey($component_section, $infid, $params_section);
  561. }
  562. if (defined($$afmap{$infid}))
  563. {
  564. AfMapAndAddKeys($components, $component,
  565. $infid, $params_section);
  566. }
  567. }
  568. }
  569. }
  570. foreach $proto_infid (keys %adapter_sections_map)
  571. {
  572. $params_section = AfParamsSectionName($proto_infid);
  573. AfAddKey($params_section, 'AdapterSections',
  574. join(',', @{$adapter_sections_map{$proto_infid}}));
  575. }
  576. }
  577. sub AfMapAndAddKeys
  578. {
  579. my ($components_db, $component, $afmap_index,
  580. $section) = @_;
  581. my ($key_to_write, $key, $value);
  582. my $map_flag;
  583. my @afkeys = @{$$afmap{$afmap_index}};
  584. foreach $afkey_item (@afkeys)
  585. {
  586. $key_to_write = defined($$$afkey_item[1]) ?
  587. $$$afkey_item[1] : $$$afkey_item[0];
  588. $key = $$$afkey_item[0];
  589. if (defined($value = $$components_db{$component}{$key}))
  590. {
  591. $map_flag = $$$afkey_item[2];
  592. if ($map_flag & $MAP_ARRAY)
  593. {
  594. my $lower_limit = $$$afkey_item[3];
  595. my $upper_limit = $$$afkey_item[4];
  596. my $base_offset = $$$afkey_item[5];
  597. my $value_map = $$$afkey_item[6];
  598. if (($value >= $lower_limit) &&
  599. ($value <= $upper_limit))
  600. {
  601. $value = $$$value_map[$value - $base_offset];
  602. }
  603. }
  604. elsif ($map_flag & $MAP_BOOL)
  605. {
  606. $value = $value ? 'Yes' : 'No';
  607. }
  608. elsif ($map_flag & $MAP_TO_LIST)
  609. {
  610. $value = join(',', @{$value});
  611. }
  612. my $af_can_write = 1;
  613. if ($map_flag & $AF_COND_ValueMatch)
  614. {
  615. my ($key_to_check, $value_to_match) =
  616. ($$$afkey_item[3], $$$afkey_item[4]);
  617. my $tval;
  618. $tval = $$components_db{$component}{$key_to_check};
  619. if ($tval != $value_to_match)
  620. {
  621. $af_can_write = 0;
  622. }
  623. }
  624. if (($value eq '') && (!($map_flag & $AF_COND_ShowIfEmpty)))
  625. {
  626. $af_can_write = 0;
  627. }
  628. if ($af_can_write)
  629. {
  630. AfAddKey($section, $key_to_write, $value);
  631. }
  632. }
  633. }
  634. }
  635. sub AfParamsSectionName
  636. {
  637. return 'params.' . $_[0];
  638. }
  639. sub AfAddSection
  640. {
  641. $af{$_[0]}{''} = '<section>';
  642. }
  643. sub AfAddKey
  644. {
  645. $af{$_[0]}{$_[1]} = $_[2];
  646. }
  647. sub WriteAnswerFile
  648. {
  649. my $af_handle = $_[0];
  650. foreach $section (keys %af)
  651. {
  652. print $af_handle "\n[$section]\n";
  653. foreach $key (keys %{$af{$section}})
  654. {
  655. next if $key eq "";
  656. $value = $af{$section}{$key};
  657. if ($value =~ /$regex_special_chars/)
  658. {
  659. $value = '"' . $value . '"';
  660. }
  661. print $af_handle "$key = $value\n";
  662. }
  663. }
  664. }
  665. sub GenAndWriteAnswerFile
  666. {
  667. my $af_handle = $_[0];
  668. GenAnswerFile();
  669. WriteAnswerFile($af_handle);
  670. }
  671. sub ShowUsage
  672. {
  673. print <<'--usage-end--';
  674. Usage:
  675. netwiz [-h|?] [-c] [-d <component-inf-id>] [-g [<file-name>]]
  676. Options:
  677. -h|-? Show this help message
  678. -c Check network configuration for consistency
  679. -d Forcefully delete the specified component from
  680. the registry. Not recommended for the faint of heart.
  681. ("Don't try it at home" type operation)
  682. -g Generate the networking portion of AnswerFile that describes
  683. the current networking configuration. If a file name
  684. is not specified, dump to stdout.
  685. --usage-end--
  686. }
  687. sub main
  688. {
  689. if ((grep {/[---\/][?h]/i} @ARGV) || ($ARGV[0] eq '') ||
  690. !GetOptions('c', 'd=s', 'g:s') ||
  691. (defined($opt_d) && ($opt_d eq '')))
  692. {
  693. ShowUsage();
  694. exit;
  695. }
  696. if ($opt_d)
  697. {
  698. GetConfirmationAndForceRemoveComponent($opt_d);
  699. }
  700. elsif (defined($opt_g))
  701. {
  702. if ($opt_g eq '')
  703. {
  704. GenAndWriteAnswerFile(STDOUT);
  705. }
  706. else
  707. {
  708. open(AF_HANDLE, ">$opt_g") || die "Cannot open $opt_g: $!";
  709. GenAndWriteAnswerFile(AF_HANDLE);
  710. close(AF_HANDLE);
  711. }
  712. }
  713. elsif ($opt_c)
  714. {
  715. CheckNetworkConfigConsistency();
  716. }
  717. }
  718. main();
  719. # -----------------------------------------------------------------
  720. # Diagonostic stuff
  721. #
  722. sub LocateComponentById
  723. {
  724. my $infid = $_[0];
  725. foreach $component_section (keys %{$comp_map})
  726. {
  727. my $class_guid = $$comp_map{$component_section}[0];
  728. my $components = $$comp_map{$component_section}[1];
  729. foreach $component (keys %{$components})
  730. {
  731. if ($$components{$component}{'InfId'} eq $infid)
  732. {
  733. return ($component, $class_guid);
  734. }
  735. }
  736. }
  737. return undef;
  738. }
  739. sub ForceRemoveComponent
  740. {
  741. my $infid = $_[0];
  742. my ($comp_guid, $comp_class_guid);
  743. if (($comp_guid, $comp_class_guid) = LocateComponentById($infid))
  744. {
  745. my $rp_class = "$rp_network\\$comp_class_guid";
  746. my $rk_class;
  747. if ($HKEY_LOCAL_MACHINE->Open($rp_class, $rk_class))
  748. {
  749. if ($ENV{'COMPUTERNAME'} =~ /(kumarp[19])/i)
  750. {
  751. print "Dont do this on $1!!\n";
  752. exit;
  753. }
  754. if (RegDeleteKeyTree($rk_class, $comp_guid))
  755. {
  756. print "Deleted: HKLM\\$rp_class\\$comp_guid\n";
  757. }
  758. else
  759. {
  760. print "Error deleting key: HKLM\\$rp_class\\$comp_guid: $!\n";
  761. }
  762. $rk_class->Close();
  763. }
  764. }
  765. }
  766. sub GetConfirmationAndForceRemoveComponent
  767. {
  768. my $infid = $_[0];
  769. if (GetConfirmation("Are you sure you want to forcefully remove '$infid'"))
  770. {
  771. ForceRemoveComponent($infid);
  772. }
  773. }
  774. sub RegDeleteKeyTree
  775. {
  776. my ($rk, $subkey) = @_;
  777. my $rk_subkey;
  778. my $result = 1;
  779. if ($result = $rk->Open($subkey, $rk_subkey))
  780. {
  781. my $tval;
  782. my %tvals;
  783. if ($result = $rk_subkey->GetValues(\%tvals))
  784. {
  785. foreach $tval (keys %tvals)
  786. {
  787. # print "deleting $subkey\\$tval...\n";
  788. last if (!$rk_subkey->DeleteValue($tval));
  789. }
  790. my $tkey;
  791. my @tkeys;
  792. if ($rk_subkey->GetKeys(\@tkeys))
  793. {
  794. foreach $tkey (@tkeys)
  795. {
  796. last if (!($result = RegDeleteKeyTree($rk_subkey, $tkey)));
  797. }
  798. }
  799. }
  800. $rk_subkey->Close();
  801. if ($result)
  802. {
  803. # print "deleting $subkey...\n";
  804. $result = $rk->DeleteKey($subkey);
  805. }
  806. }
  807. return $result;
  808. }
  809. sub CheckNetworkConfigConsistency
  810. {
  811. print "Checking services...\n";
  812. CheckCoServices();
  813. print "...done\n";
  814. }
  815. #
  816. # - check that services listed using CoServices key are actually installed.
  817. #
  818. sub CheckCoServices
  819. {
  820. foreach $component_class ('NetProtocols', 'NetServices', 'NetClients')
  821. {
  822. my $components = $$comp_map{$component_class}[1];
  823. foreach $component (keys %{$components})
  824. {
  825. my @coservices;
  826. my @coservices_not_installed;
  827. my $infid = $$components{$component}{'InfId'};
  828. next if $infid eq '';
  829. # print "$infid...";
  830. @coservices = @{$$components{$component}{'CoServices'}};
  831. @coservices_not_installed = SubtractLists(\@coservices,
  832. \@installed_services);
  833. if (scalar @coservices_not_installed)
  834. {
  835. print("$infid: the following service(s) are required for successful operation of this component, but do not seem to be installed: ",
  836. join(', ', @coservices_not_installed));
  837. }
  838. }
  839. }
  840. }
  841. sub SubtractLists
  842. {
  843. my ($list1, $list2) = @_;
  844. my @result;
  845. @result = grep { !IsInList($_, $list2) } @$list1;
  846. return @result;
  847. }
  848. sub GetCommonItems
  849. {
  850. my ($list1, $list2) = @_;
  851. my @common_items;
  852. @common_items = grep { IsInList($_, $list2) } @$list1;
  853. return @common_items;
  854. }
  855. sub IsInList
  856. {
  857. my $item = lc($_[0]);
  858. my @item_list = @{$_[1]};
  859. return scalar grep { lc($_) eq $item } @item_list;
  860. }
  861. sub IsInList1
  862. {
  863. my $item = lc($_[0]);
  864. my @item_list = @{$_[1]};
  865. my $t_item;
  866. foreach $t_item (@item_list)
  867. {
  868. if (lc($t_item) eq $item)
  869. {
  870. return 1;
  871. }
  872. }
  873. return 0;
  874. }
  875. # -----------------------------------------------------------------
  876. # Misc helper stuff
  877. #
  878. sub GetConfirmation
  879. {
  880. my $question = $_[0];
  881. my $answer;
  882. while (!($answer =~ /[yn]/i))
  883. {
  884. print "$question ? [y/n]\n";
  885. $answer = <STDIN>;
  886. }
  887. return $answer =~ /[y]/i;
  888. }
  889. # -----------------------------------------------------------------
  890. # Misc debug helper stuff
  891. #
  892. sub pl
  893. {
  894. print "Items: ", join(", ", @_), "\n";
  895. };
  896. sub p
  897. {
  898. print join(", ", @_), "\n";
  899. };
  900. # -----------------------------------------------------------------