The network subnet that I administer recently had its private subnet address modified as the result of a change in the manner in which it is connected to the larger organization of which this office is a part. As networked printers in the office are primarily installed as TCP/IP printers, and individual windows workstations are connected to them as Standard TCP/IP ports, I regarded the task of modifying the addresses of anywhere from one to four printers on a sizeable number of workstations as reasonably formidable, and after a colleague challenged me I determined to write something to automate the process.

The discussion that follows is written for those with similar responsibilities who have, at best, only a basic level of familiarity with perl. It is not intended as a perl or perl/tk tutorial, but generally to be sufficiently descriptive to allow it to be used in concert with perl and perl/tk references such as those included in the links page in gaining an understanding of how it works. It can be used as is, but it can also be modified to address a different context. Needless to say, neither I nor the organization with which I am affiliated are to be held responsible for the inappropriate application of this script in either its original or in a modified form. Always test such resources on a non-critical machine before using them on a production machine ... that is just common sense.

The basic strategy I employed here was to modify the address to which the pertinent TCP/IP port points. By default, when a printer is attached to a machine via a local TCP/IP port, the port is named with the address specified for the port, prefaced with the string "IP_", but that name can be modified if desired. As this name is used in other locations in the registry, I determined to simply change the address rather than somehow change the name to reflect the new address.

The initial plan was for an abrupt changeover to the new subnet, but that was shortly modified to include a period of two to three weeks during which both sets of addresses would be active. I had previously written a small applet that lists installed ODBC drivers on domain machines, and as the framework of that applet could readily be adapted to this context I was able to create the first working version of the applet I will be discussing here in no more than three or four hours. The applet I used was configured to allow the modification of a single address on a selectable set of machines. It can, however, be readily modified to change the class c subnet address (the first three segments) of every printer on a given subnet attached via a Standard TCP/IP Port, as I will illustrate later. This script requires domain administrator rights to run in a domain, of course, and would require a local id on each machine in a workgroup with the same name and password as the account under which it is being run on the host machine, which renders it somewhat less practical in such an environment. It has been tested only in an NT 4.0 domain, but should run in domains hosted on later versions of Wndows Server. Machines whose registries have been modified with this script will require a restart before the modifications will be effective.

For those unfamiliar with perl/tk, the initial part of the program code establishes the environment for the script and defines the widgets (interface elements) that in one way or another implement the application functionality. Those elements and the environment construct the application event loop, which executes actions associated with widgets that are part of the interface. The MainLoop statement that initiates the event loop is the final statement in the main section of the program, and it is at this point that whatever gui elements that have previously been defined are displayed. The following code snippet represents that portion of this script.

##this applet allows the remote modification of the addresses used by printers installed to print to standard tcpip ports on nt, win2k and xp machines.
##  the name of the port itself is not modified, just the address to which it points.  
##this script is provided as is ... the user is responsible for any problems associated with its use
use Tk;
use Tk::LabEntry;
use strict;
use Win32::NetAdmin;
use Win32::TieRegistry;



##domain-related
my (@domains,@machines,$machine_box);

##widget-related
my ($domain_box,$machine_box,$sel_domain,$out,$clear_btn,$clear_machine_btn,$domain_btn,$machine_btn,$change_btn,$domain_label,$machine_label);

##machine-related
my ($remote_hive,$full_path,$key_spec,$settings,$cm);

##set the registry delimiter to something other than / ... otherwise, it treats the term TCP/IP as two twigs in the registry hive
my $init = $Registry->Delimiter('-');

my $st=Win32::NetAdmin::GetServers('','',SV_TYPE_DOMAIN_ENUM,\@domains);

##hash contains the addresses to be changed
my %nets;
$nets{'old'}='xxx.xxx.xxx.xxx';
$nets{'new'}='xxx.xxx.xxx.xxx';
my $nets=\%nets;


my $mw=MainWindow->new;
$mw->configure(-title=>'Change Addresses for TCP/IP Printer Ports',
			   -background=>'blue',
			   -width=>"700",
			   -height=>"500");


my $domain_frame=$mw->Frame()->pack(-side=>'left',-fill=>'x');
my $mach_frame=$mw->>Frame()->pack(-side=>'right',-fill=>'x');;
my $menu_frame=$mw->Frame(-borderwidth=ɯ,	
						  -background=>'brown')
						  ->pack(-side=>'top');

			


##buttons to trigger actions
$domain_btn=$menu_frame->Button(-text=>"Select Domain",-command=>sub {$domain_box->insert('end',@domains)})->pack(-side=>'left',-anchor=>'w');
$machine_btn=$menu_frame->Button(-text=>"Select Machine(s)",-command=>sub {sel_machine()})->pack(-side=>'left',-anchor=>'n');
$change_btn=$menu_frame->Button(-text=>"Change Addresses on Selected Machines",-command=>sub {sum_boxes($nets)})->pack(-side=>'left',-anchor=>'e');

##widgets for domain and machine listings
$domain_label=$domain_frame->Label(-text=>'Domain(s)')->pack(-side=>'top');
$domain_box=$domain_frame->Listbox()->pack(-side=>'left');
$machine_label=$mach_frame->Label(-text=>'Machine(s)')->pack(-side=>'top');
$machine_box=$mach_frame->Scrolled('Listbox')->pack(-side=>'left',-anchor=>'e');
$machine_box->configure(-selectmode=>"multiple");

##text widget for operation feedback
$out=$mw->Scrolled("Text")->pack(-side=>'top');

##buttons to clear feedback and machine widgets 
$clear_btn=$mw->Button(-text=>"Clear Feedback Window", -command=> sub {$out->delete("0.0",'end')})->pack(-side=>'right',-anchor=>'s');
$clear_machine_btn=$mw->Button(-text=>"Clear Machine Window", -command=> sub {$machine_box->delete("0.0",'end')})->pack(-side=>'right',-anchor=>'s');


##address entry widgets
my $old_label=$mw->Label(-text=>'Old Address', -background=>'red')->pack(-side=>'left');
my $old_entry=$mw->LabEntry (-text=>'Old Address',-textvariable=>\$nets->{'old'})->pack(-side=>'left');
my $new_label=$mw->Label(-text=>'New Address', -background=>'red')->pack(-side=>'left');
my $new_entry=$mw->LabEntry (-text=>'New Address',-textvariable=>\$nets->{'new'})->pack(-side=>'left');	
											   
MainLoop;
 

The use statements identify the perl modules required for the script's operation, as well as specifying that the strict pragma is in force. The Tk module provides the foundation of the Tk environment in perl, and the Tk::LabEntry module extends that foundation to facilitate the creation of data entry widgets. Win32::NetAdmin provides access to windows domain information and functions, and Win32::TieRegistry provides the capability to tie all or part of a machine's registry to a perl hash, in this context thus allowing the modification of the printer port address. All of these modules are part of the base ActiveState perl distribution, so no seperate installation is required. The strict pragma is a module internal to all modern perl versions that enforces strict error-checking. When used without additional arguments, as it is here, that error-checking is at its most strict, and global to the applet.

Following module initialization, the script defines a set of data structures that will be used and changes the default delimiter by which Win32::TieRegistry will recognize registry paths to a hyphen ("-"). This is necessary because the default used by the module is the slash ("/"), and as the name of the base key with which I am concerned is "Standard TCP/IP Ports", the module will read that string as representing two seperate keys, "Standard TCP" and "IP Ports", which it will not find. The next statement populates the @domains array with a list of visible domains, and then a hash is created to hold the address to be changed and the address to which it should be changed.

The remainder of the main section of the script defines the applet gui. For the most part I would suggest consulting the Perl/Tk references in the links page for more detail about the specific manner in which the components are implemented, but in general here Tk uses a parent window widget with which child widgets are associated. Here I create the main windows $mw, named in accordance with common Perl/Tk convention, and attach three frames to $mw, oriented to the left, right, and top of $mw. Frames allow widgets to be placed in designated areas of the widget to which they are assigned, and are one of the primary manners in which window real estate is managed. Within the menu frame at the top of $mw I place three buttons, selection of which implements the actions associated with selecting the domain to which the machines on which the address should be changed belong, the display and selection of the machine(s) on which the address should be changed, and the execution of the change operation itself. I create listbox widgets in the left and right frames to hold the list of visible domains and the list of machines in the selected domain, respectively. The $machine_box listbox in the frame on the right is configured to allow the selection of multiple items. $out is a scrolled text widget attached to $mw, and intended as a destination for feedback messages. Finally, I anchor a couple of buttons on the bottom right hand side of $mw that clear $out and $machine_box, and put a couple of entry widgets on the bottom left hand side of $mw that allow the editing of the old and new addresses for the printer. These steps generate this:

Clicking on the "Select Domain" button populates the $domain_box listbox with the contents of the @domains array through the execution of the statement specified in the command argument of the button object. Once a domain is selected, a click on the "Select Machine" button executes the sel_machine() subroutine

sub sel_machine	{
##retrieve the selected domain, use it to retrieve the list of machines visible in the domain, and display those machines in $machine_box
	
	my @selection=$domain_box->curselection;
	my $selected_domain=$domains[$selection[0]];	
	$st=Win32::NetAdmin::GetServers('',$selected_domain,SV_TYPE_NT,\@machines);
	$machine_box->insert('end',@machines);

	}         

sub sum_boxes	{
##retrieve the selected machines from the $machine_box widget into an array, and for each selected machine execute the machine subroutine	
	my $nets=$_[0];
	my @selected_machines=$machine_box->curselection;
	my $box;
	$out->insert('end','Change'.' '.$$nets{'old'}.' to '.$$nets{'new'}."  "."\n");
	foreach $box (@selected_machines)	{
		machine($machines[$box],$out,$nets);
	}
}

The sum_boxes() subroutine (the name is a remnant of the earlier version of the script that summarized installed odbc drivers) retrieves the set of machines that have been selected into an array, prints a line to the $out text widget detailing the address change, and loops over the contents of the array of selected machines, executing the machine() subroutine for each selected machine. Note, however, the manner in which I handle the selected set in this subroutine as opposed to the manner in which I retrieve the selected domain in sel_machine(). The curselection method of a Perl/Tk listbox widget returns an array of the index positions of the selected items in the original array that was used to populate the listbox. As the $domain_box widget is configured to allow the selection of only one domain at a time, the index value of the selected domain will always be the first, and only, element in the array of selections; selection[0] in sel_machine(). As $machine_box is configured for multiple selections, sum_boxes() must allow for the possibility of a multiple selection, hence the loop.

The machine() subroutine connects to the registry of a specific selected machine and executes change_address(), which starts to take actions specific to the address modification.

sub machine	{
##this subroutine connects to the registry of an individual machine and executes a subroutine
	
	my ($cm,$out,$nets)=@_;

 	my ($remote_hive,$working_hive);

	$out->insert("end","\n\n"."MACHINE: ".$cm."\n");

	##list of the hives on the machine for which an action must be taken
	my @hives=('LMachine');


	foreach $working_hive (@hives)	{
		 
		##connect to the remote registry
		my $remote_hive=$Registry->Connect($cm,$working_hive);

		##if the connection was successful ...
		if ($remote_hive)	{
			##if this is the HKEY_LOCAL_MACHINE hive
			if ($working_hive=~/LMa/)	{change_address(\$remote_hive,$nets);}
			}
		##if the connnection was not successful
		elsif (!$remote_hive)	{
			$out->insert('end',"Connection to $cm failed\n\n");
		}
	}
}

The sum_boxes() and machine() subroutines operated on the domain and machine levels, respectively, and it is with the change_address() subroutine that I start to get down to the nitty-gritty of changing addresses.

sub change_address	{
	
	##this subroutine operates on the specified keys under the major key of interest		
	($remote_hive,$nets)=@_;
				
	my $key_spec='System-CurrentControlSet-Control-Print-Monitors-Standard TCP/IP Port';					
	##store a reference to a hash of the keys and values under "Standard TCP/IP Ports" 
	my $working_key=$$remote_hive->Open($key_spec);
	my ($major_key,@subkeys,$sub);	
				
	##the previous instance in which I used this structure iterated through more than one subkeys
	##of this major key, and those keys were stored in the array @subject_keys.  Although I am only
	##concerned with one subkey at present, I have decided to maintain that basic structure
	my @subject_keys=('Ports');

	##the following 
	
	##remove any leading and trailing whitespace, just in case
	$$nets{'old'}=~s/^\s+//;
	$$nets{'old'}=~s/\s+$//;
	$$nets{'new'}=~s/^\s+//;
	$$nets{'new'}=~s/\s+$//;	

	##make sure that the address specifications are in the appropriate format ... while the labentry widget
	##has a validate clause, the documentation specifically warns that it's operation is questionable when
	##the widget uses the textvariable option.  hence the regular expressions here used to verify the form 
	##of the address specification
	if (($$nets{'old'} !~ /\d{1,3}\.\d{1,3}\.\d{1,3}.\d{1,3}/) or ($$nets{'new'} !~ /\d{1,3}\.\d{1,3}\.\d{1,3}.\d{1,3}/)) {
		$out->insert('end',"One or both of the subnets are inappropriately specified\n");
	}
	##if both addresses are appropriately specified ...
	elsif (($$nets{'old'} =~ /\d{1,3}\.\d{1,3}\.\d{1,3}.\d{1,3}/) and  ($$nets{'new'} =~ /\d{1,3}\.\d{1,3}\.\d{1,3}.\d{1,3}/)){
		##for each element in the @subject_keys array
		foreach $major_key (@subject_keys)	{
			##print the array element					
			$out->insert('end',$major_key."\n\n");
			##store a reference to the hash of settings (keys and values) for the key named with that array element to $settings
			$settings=$working_key->{$major_key};
					
			##if that reference was succesfully stored
			if ($settings)	{
															
					##for each $key in the hash of ports
					my ($key,$value);										
					while (($key,$value)=each(%$settings))	{
									
							##print the name of the key (the port name) to the output window
							$out->insert('end',$key."\n") if $key !~ /^-/;
							##swap_addr() is where the job gets done
							swap_addr($key,\$out,\$settings,$nets) if $key !~ /^-/;
					
						}
						
				}					
			##if the $settings hashref does not exist, the array element was not a valid key
			elsif (!$settings)	{
						
				$out->insert('end',"Unable to connect to $major_key under $key_spec\n\n");
			}
		}
	}			
}	

The swap_addr() subroutine actually modifies the address.

sub swap_addr {
##this subroutine swaps one ip address for another.  $settings is a reference to a hash holding all of the registry keys
##under standard tcp/ip ports on a given machine, and $current_key represents the specific key being processed here.	
	
	my ($current_key,$out,$settings,$nets)=@_;
	my ($subkey,$key,$value,$r);
	##store a reference to the hash holding the settings for the specific port 
	$subkey=$$settings->{$current_key};

	##iterate through the values of the subkey, swapping the old address with the new if it is found
	while (($key,$value)=each(%$subkey))	{
			
                ##if the value associated with the current key matches the old address, replace it with the new address				
				$subkey->{$key}=~s/$$nets{'old'}/$$nets{'new'}/ if ($subkey->{$key}=~/$$nets{'old'}/);

			} 
			##flush (write) the registry on the target machine.  if the flush fails, output a message indicating that the 
			##update failed 			
			$r=$subkey->Flush();
			$out->insert("end","\nUpdate on this machine failed. \n Try again later, or modify manually\n") if $r=0;
}

Once run, the applet gui will look something like this:

Modification of this script to change all of the printers on a given subnet is very easy. As the actual modification is accomplished with a regular expression, it is only necessary to modify the various locations in which the actual form of the address is specified to contain three segments rather than four. The creation of the %nets hash, for example, now becomes

my %nets;
$nets{'old'}='xxx.xxx.xxx';
$nets{'new'}='xxx.xxx.xxx';

				if (($$nets{'old'} !~ /\d{1,3}\.\d{1,3}\.\d{1,3}/) or ($$nets{'new'} !~ /\d{1,3}\.\d{1,3}\.\d{1,3}/))

While this discussion has involved a very specific task, the combination of the Win32 perl modules and the Tk library provides a powerful tool that can be used to modify settings on machines in a windows domain. There are commercial products available to achieve the same ends, but not every organization has the financial resources to purchase those products. Further, it is quite possible that a given product may not provide the specific functionality required for a given task. The expenditure of some time to familiarize oneself with these tools can greatly ease administrative tasks.