version 1.4, 2010/12/10 23:28:09
|
version 1.6, 2010/12/14 20:32:49
|
Line 13 BEGIN {
|
Line 13 BEGIN {
|
delete @ENV{qw(IFS CDPATH ENV BASH_ENV PATH)}; |
delete @ENV{qw(IFS CDPATH ENV BASH_ENV PATH)}; |
$ENV{PATH} = "/bin:/usr/bin"; |
$ENV{PATH} = "/bin:/usr/bin"; |
$|++; |
$|++; |
# Flip this back on for more detailed error reporting |
$SIG{__DIE__} = sub { require Carp; Carp::confess(@_); } |
# $SIG{__DIE__} = sub { require Carp; Carp::confess(@_); } |
|
} |
} |
|
|
use strict; |
use strict; |
Line 30 use threads;
|
Line 29 use threads;
|
use threads::shared; |
use threads::shared; |
|
|
## |
## |
## Fetch our command line options |
## Fetch our command line and configuration options |
## |
## |
my %opts = &fetchOptions( ); |
my %opts = &fetchOptions( ); |
my $pidFile = "/var/run/telnetbbs.pid"; |
my %cfg = &fetchConfig( ); |
my $EOL = "\015\012"; |
my $EOL = "\015\012"; |
|
|
## |
## |
## These will be moved in to a config file |
## These will be moved in to a config file |
## |
## |
my $DISPLAY = ":0.0"; |
my $BBS_NODE = 0; |
my $BBS_NAME = "Hell's Dominion BBS"; |
my $pidFile = $cfg{'pidfile'} || "/tmp/telnetbbs.pid"; |
my $BBS_NODE = 0; |
my $port = $opts{'port'} || $cfg{'port'} || 23; |
my $DBCONF = "/tmp/dosbox-__NODE__.conf"; |
my $DISPLAY = $cfg{'display'} || ":0.0"; |
my $BBS_CMD = "DISPLAY=$DISPLAY /usr/bin/dosbox -conf "; |
my $BBS_NAME = $cfg{'bbs_name'} || "Hell's Dominion BBS"; |
my $LOG = "/var/log/bbs.log"; |
my $DBCONF = $cfg{'dosbox_cfg'} || "/tmp/dosbox-__NODE__.conf"; |
my $MAX_NODE = 1; |
my $BBS_CMD = $cfg{'bbs_cmd'} || "DISPLAY=$DISPLAY /usr/bin/dosbox -conf "; |
my $DOSBOXT = "dosbox.conf.template"; |
my $LOGGING = $cfg{'logging'} || 0; |
my $BASE_PORT = 5000; |
my $LOG = $cfg{'log_path'} || "/tmp/bbs.log"; |
|
my $MAX_NODE = $cfg{'nodes'} || 1; |
|
my $DOSBOXT = $cfg{'dosboxt'} || "dosbox.conf.template"; |
|
my $BASE_PORT = $cfg{'base_port'} || 7000; |
|
my $LOCK_PATH = $cfg{'lock_path'} || "/tmp"; |
|
|
## |
## |
## Check that we are 'root' |
## Check that we are 'root' |
## |
## |
die( "Must be root user to run this.\n" ) |
die( "Must be root user to run this.\n" ) |
if ( getpwuid( $> ) ne "root" ); |
if ( getpwuid( $> ) ne "root" && $port < 1023 ); |
|
|
## |
## |
## Check for a PID |
## Check for a PID |
Line 74 local $SIG{HUP} = $SIG{INT} = $SIG{TERM
|
Line 77 local $SIG{HUP} = $SIG{INT} = $SIG{TERM
|
## |
## |
## Open the Log |
## Open the Log |
## |
## |
#open LOG, ">>$LOG"; |
open LOG, ">>$LOG" if ( $LOGGING ); |
&logmsg( "Starting telnetbbs server" ); |
&logmsg( "Starting telnetbbs server" ); |
|
|
## |
## |
|
## Display running information |
|
## |
|
&display_config_and_options( \%opts, "Options" ); |
|
&display_config_and_options( \%cfg, "Configuration" ); |
|
|
|
## |
## Start the network server |
## Start the network server |
## |
## |
my $netThread = threads->create( \&startNetServer( ) ); |
my $netThread = threads->create( \&startNetServer( ) ); |
Line 98 while( 1 ) { sleep 1; }
|
Line 107 while( 1 ) { sleep 1; }
|
############################################################################### |
############################################################################### |
############################################################################### |
############################################################################### |
|
|
sub logmsg { print "$0 $$ ", scalar localtime, ":@_\n" } |
sub logmsg |
|
{ |
|
my $message = "$0 $$ " . scalar( localtime( ) ) . ":@_\n"; |
|
print STDOUT $message; |
|
print LOG $message if ( $LOGGING ); |
|
} |
|
|
|
|
|
############################################################################### |
|
############################################################################### |
|
sub display_config_and_options |
|
{ |
|
my $hr = shift || 0; |
|
my $name = shift || "Unknown"; |
|
my $title = "Displaying $name\n"; |
|
|
|
return $hr if ( ! $hr ); |
|
|
|
print LOG $title . Dumper( $hr ) if ( $LOGGING ); |
|
print STDOUT $title . Dumper( $hr ) if ( $opts{'verbose'}); |
|
} |
|
|
############################################################################### |
############################################################################### |
## startNetServer( ); |
## startNetServer( ); |
Line 111 sub startNetServer
|
Line 140 sub startNetServer
|
{ |
{ |
my $hostConnection; |
my $hostConnection; |
my $childPID; |
my $childPID; |
my $port = $opts{'port'} || 23; |
|
my @nodes = ( ); |
my @nodes = ( ); |
|
|
my $server = IO::Socket::INET->new( |
my $server = IO::Socket::INET->new( |
Line 134 sub startNetServer
|
Line 162 sub startNetServer
|
## Find the next available node |
## Find the next available node |
## |
## |
my $node = 0; |
my $node = 0; |
|
my $lock_file = ""; |
foreach (1 .. $MAX_NODE) |
foreach (1 .. $MAX_NODE) |
{ |
{ |
next if ( $node ); |
print "Searching for lock: " . $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock\n"; |
if ( ! $nodes[$_] ) |
next if ( -f $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock" ); |
{ |
|
$node = $BBS_NODE = $_; |
|
$nodes[$node]++; |
|
} |
|
} |
|
|
|
print STDOUT "Node Status: \n" . Dumper( @nodes ); |
## |
|
## Create node lock file |
|
## |
|
$lock_file = $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock"; |
|
open LOCK, ">$lock_file"; |
|
close( LOCK ); |
|
$node = $BBS_NODE = $_; |
|
} |
|
print "Using lock: " . $LOCK_PATH."/".$BBS_NAME."_node".$node.".lock\n"; |
|
|
## |
## |
## Create our dosbox config |
## Create our dosbox config |
Line 175 print STDOUT "Node Status: \n" . Dumper(
|
Line 207 print STDOUT "Node Status: \n" . Dumper(
|
} |
} |
defined( $childPID ) || die( "Cannot fork: $!\n" ); |
defined( $childPID ) || die( "Cannot fork: $!\n" ); |
|
|
|
select $hostConnection; |
|
|
## |
## |
## Default file descriptor to the client and turn on autoflush |
## Default file descriptor to the client and turn on autoflush |
## |
## |
$hostConnection->autoflush( 1 ); |
$hostConnection->autoflush( 1 ); |
|
|
print $hostConnection "Welcome to $BBS_NAME!" . $EOL; |
print "Welcome to $BBS_NAME!" . $EOL; |
|
|
## |
## |
if ( ! $BBS_NODE ) |
if ( ! $lock_file ) |
{ |
{ |
print $hostConnection "No available nodes. Try again later.".$EOL; |
print "No available nodes. Try again later.".$EOL; |
exit; |
exit; |
} |
} |
|
|
print $hostConnection "Starting BBS on node $BBS_NODE...$EOL"; |
print "Starting BBS on node $BBS_NODE...$EOL"; |
|
|
## |
## |
## Launch BBS via dosbox |
## Launch BBS via dosbox |
Line 197 print STDOUT "Node Status: \n" . Dumper(
|
Line 231 print STDOUT "Node Status: \n" . Dumper(
|
my $bbsPID = fork( ); |
my $bbsPID = fork( ); |
if ( $bbsPID ) |
if ( $bbsPID ) |
{ |
{ |
|
select STDOUT; |
my $cmd = $BBS_CMD . $DBCONF; |
my $cmd = $BBS_CMD . $DBCONF; |
exec( $cmd ); |
system( $cmd ); |
|
print "Shutting down node $BBS_NODE\n"; |
|
## |
|
## Remove Lock |
|
## |
|
unlink( $lock_file ); |
|
unlink( $DBCONF ); |
exit; |
exit; |
} |
} |
|
|
Line 229 print STDOUT "Node Status: \n" . Dumper(
|
Line 270 print STDOUT "Node Status: \n" . Dumper(
|
print $hostConnection $byte; |
print $hostConnection $byte; |
} |
} |
$nodes[$BBS_NODE] = 0; |
$nodes[$BBS_NODE] = 0; |
print "Post-Disconnect Node Status: \n" . Dumper( @nodes ); |
|
kill( "TERM" => $kidpid ); |
kill( "TERM" => $kidpid ); |
} |
} |
else |
else |
Line 262 sub shutdown
|
Line 302 sub shutdown
|
{ |
{ |
my $signame = shift || 0; |
my $signame = shift || 0; |
|
|
|
select STDOUT; |
|
|
&logmsg( "$0: Shutdown (SIG$signame) received.\n" ) |
&logmsg( "$0: Shutdown (SIG$signame) received.\n" ) |
if( $signame ); |
if( $signame ); |
|
|
## |
## |
## Close Log |
## Close Log |
## |
## |
close( LOG ); |
close( LOG ) if ( $LOGGING ); |
|
|
## |
## |
## Remove the PID |
## Remove the PID |
Line 384 sub processExists
|
Line 426 sub processExists
|
return 0; |
return 0; |
} |
} |
|
|
|
############################################################################### |
|
############################################################################### |
|
sub fetchConfig |
|
{ |
|
my %conf = ( ); |
|
my $cf = &findConfig; |
|
|
|
if ( $cf ) |
|
{ |
|
open( CONF, "<$cf" ) or die ( "Error opening $cf: $!\n" ); |
|
while( <CONF> ) |
|
{ |
|
next if ( $_ =~ m/^#/ ); |
|
if ( $_ =~ m/(.*?)=(.*)/ ) |
|
{ |
|
my $k = $1; my $v = $2; |
|
$k =~ s/\s+//; |
|
$v =~ s/\s+//; |
|
$conf{$k} = $v; |
|
} |
|
} |
|
close( CONF ); |
|
} |
|
|
|
return %conf; |
|
} |
|
|
|
############################################################################### |
|
############################################################################### |
|
sub findConfig |
|
{ |
|
my $cf = 0; |
|
my @paths = qw| ./ ./.telnetbbs /etc /usr/local/etc |; |
|
|
|
foreach ( @paths ) |
|
{ |
|
my $fn = $_ . "/telnetbbs.conf"; |
|
return $fn if ( -f $fn ); |
|
} |
|
|
|
return $cf; |
|
} |
|
|
############################################################################### |
############################################################################### |
## |
## |
Line 399 sub fetchOptions {
|
Line 483 sub fetchOptions {
|
"help|?" => \$opts{'help'}, |
"help|?" => \$opts{'help'}, |
"man" => \$opts{'man'}, |
"man" => \$opts{'man'}, |
"port:i" => \$opts{'port'}, |
"port:i" => \$opts{'port'}, |
|
"verbose" => \$opts{'verbose'}, |
) || &pod2usage( ); |
) || &pod2usage( ); |
&pod2usage( ) if defined $opts{'help'}; |
&pod2usage( ) if defined $opts{'help'}; |
&pod2usage( { -verbose => 2, -input => \*DATA } ) if defined $opts{'man'}; |
&pod2usage( { -verbose => 2, -input => \*DATA } ) if defined $opts{'man'}; |