version 1.3, 2010/01/11 05:02:27
|
version 1.8, 2010/12/16 21:38:46
|
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(@_); } |
} |
} |
|
|
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 @nodes = ( ); |
|
my $EOL = "\015\012"; |
my $EOL = "\015\012"; |
|
|
## |
## |
## These will be moved in to a config file |
## These are read in from the config file |
## |
## |
my $DISPLAY = ":1018.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 = 6; |
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 75 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( ) ); |
|
|
|
|
while( 1 ) { sleep 1; } |
while( 1 ) { sleep 1; } |
|
|
Line 96 while( 1 ) { sleep 1; }
|
Line 105 while( 1 ) { sleep 1; }
|
## Sub-routines begin here |
## Sub-routines begin here |
## |
## |
############################################################################### |
############################################################################### |
|
|
|
|
|
############################################################################### |
|
## |
|
## &logmsg( "string" ); |
|
## |
|
## This takes a string and prepends the process name, ID and timestamp |
|
## to the message. It then displays it to STDOUT and logs it if enabled. |
|
## |
|
############################################################################### |
|
sub logmsg |
|
{ |
|
my $message = "$0 $$ " . scalar( localtime( ) ) . ":@_\n"; |
|
print STDOUT $message; |
|
print LOG $message if ( $LOGGING ); |
|
} |
|
|
|
|
|
############################################################################### |
|
## |
|
## &display_config_and_options( %hash ); |
|
## |
|
## This will display via Data::Dumper a hash that is passed to it. |
|
## If verbose is enabled it will got to STDOUT and if logging is enabled |
|
## it will be logged. |
|
## |
|
## This is called only once during startup. |
|
## |
############################################################################### |
############################################################################### |
|
sub display_config_and_options |
|
{ |
|
my $hr = shift || 0; |
|
my $name = shift || "Unknown"; |
|
my $title = "Displaying $name\n"; |
|
|
sub logmsg { print "$0 $$ ", scalar localtime, ":@_\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 157 sub startNetServer
|
{ |
{ |
my $hostConnection; |
my $hostConnection; |
my $childPID; |
my $childPID; |
my $port = $opts{'port'} || 23; |
my @nodes = ( ); |
|
|
my $server = IO::Socket::INET->new( |
my $server = IO::Socket::INET->new( |
LocalPort => $port, |
LocalPort => $port, |
Line 133 sub startNetServer
|
Line 179 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 ); |
next if ( -f $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock" ); |
if ( ! $nodes[$_] ) |
|
{ |
## |
$node = $BBS_NODE = $_; |
## Create node lock file |
$nodes[$_]++; |
## |
} |
$lock_file = $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock"; |
|
open LOCK, ">$lock_file"; |
|
close( LOCK ); |
|
$node = $BBS_NODE = $_; |
} |
} |
|
|
## |
## |
Line 172 sub startNetServer
|
Line 222 sub startNetServer
|
} |
} |
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 194 sub startNetServer
|
Line 246 sub startNetServer
|
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 225 sub startNetServer
|
Line 284 sub startNetServer
|
{ |
{ |
print $hostConnection $byte; |
print $hostConnection $byte; |
} |
} |
kill( "TERM" => $childPID ); |
$nodes[$BBS_NODE] = 0; |
|
kill( "TERM" => $kidpid ); |
} |
} |
else |
else |
{ |
{ |
Line 257 sub shutdown
|
Line 317 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 271 sub shutdown
|
Line 333 sub shutdown
|
unlink( $pidFile ); |
unlink( $pidFile ); |
|
|
## |
## |
|
## Remove node lock files |
|
## |
|
foreach (1 .. $MAX_NODE) |
|
{ |
|
my $node_lock = $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock"; |
|
unlink( $node_lock ) if ( -f $node_lock ); |
|
} |
|
|
|
## |
## Wait for the thread to shutdown |
## Wait for the thread to shutdown |
## |
## |
# $netThread->detach( ); |
# $netThread->detach( ); |
Line 379 sub processExists
|
Line 450 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 |; |
|
|
|
return $opts{'config'} if defined $opts{'config'}; |
|
|
|
foreach ( @paths ) |
|
{ |
|
my $fn = $_ . "/telnetbbs.conf"; |
|
return $fn if ( -f $fn ); |
|
} |
|
|
|
return $cf; |
|
} |
|
|
############################################################################### |
############################################################################### |
## |
## |
Line 391 sub fetchOptions {
|
Line 506 sub fetchOptions {
|
my %opts; |
my %opts; |
|
|
&GetOptions( |
&GetOptions( |
|
"config:s" => \$opts{'config'}, |
"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'}; |
Line 412 telnetbbs.pl - A telnet server designed
|
Line 529 telnetbbs.pl - A telnet server designed
|
telnetbbs.pl [options] |
telnetbbs.pl [options] |
|
|
Options: |
Options: |
|
--config,c Specify the configuration file to use |
--help,? Display the basic help menu |
--help,? Display the basic help menu |
--man,m Display the detailed man page |
--man,m Display the detailed man page |
--port,p Port to listen on, default 23. |
--port,p Port to listen on, default 23. |
|
--verbose,v Enable verbose output |
|
|
=head1 DESCRIPTION |
=head1 DESCRIPTION |
|
|