my $os = $^O; ############# Global Variables ############## my $cwd; chomp( my $hostname = `hostname`); if ( defined $ENV{PMID} ) { $hostname = $ENV{PMID}; } if ( $os eq 'MSWin32' ) { eval "use Win32"; $cwd = Win32::GetCwd(); $cwd = Win32::GetShortPathName( $cwd ); $hostname = uc($hostname); } else { chomp ( $cwd = `pwd` ); } my $tuxconfig = $cwd . "\/TUXCONFIG"; ################################################ # search array of integers a for given integer x # return index where found or -1 if not found sub bsearch { my ($x, @a) = @_; # search for x in array a my ($l, $u) = (0, $#a); # lower, upper end of search interval my $i; # index of probe while ($l <= $u) { $i = int(($l + $u)/2); #print $i, "\n"; if ($a[$i] < $x) { $l = $i+1; } elsif ($a[$i] > $x) { $u = $i-1; } else { return $i; # found } } return -1; # not found } sub get_ipckey() { if ( $os eq 'MSWin32' ) { return 0xbea0; } ############################################################## # create an array of all the currently used ipckeys ############################################################## my @used_ipckeys; # create the array of used_ipckeys my $cmd = "ipcs -a | sed 's/^[smq]/& /g' | awk '{print \$2}'"; open( P, $cmd . "|" ); while (
) {
# add each value to the array as a scalar (hence the '+ 0').
$used_ipckeys[++$#used_ipckeys] = ($_ + 0);
}
close( P );
#my $rc = ($? >> 8);
#print "rc = $rc\n";
# sort the array in numeric ascending order so we can use
# bsearch to search the array
@used_ipckeys = sort { $a <=> $b } ( @used_ipckeys );
#print "@used_ipckeys" . "\n";
##############################################################
# select the first available ipckey that is not currently used
##############################################################
my $ipckey;
for ( $ipckey = 32769; $ipckey < 262143; $ipckey++ )
{
#print "Checking ipckey $ipckey...\n";
if ( bsearch( $ipckey, @used_ipckeys ) == -1 ) {
last;
}
}
return "$ipckey";
}
sub get_tuxconfig()
{
return $tuxconfig;
}
sub get_wsnaddr()
{
my $wsnaddr = "//" . $hostname . ":10000";
return $wsnaddr;
}
sub gen_ubbconfig()
{
my $ipckey = get_ipckey();
# open the template file
my $templateFile = "ubbconfig.template";
open( TEMPLATE, $templateFile ) ||
die ( "Can't open $templateFile $!\n" );
# open the ubbconfig file for writing
my $ubbconfig = "ubbconfig";
open( UBBCONFIG, ">$ubbconfig" ) ||
die ( "Can't open $ubbconfig: $!\n" );
chomp( my $pwd = $cwd );
while ( )
{
s/