--- telnetbbs/telnetbbs.pl 2010/01/06 13:33:19 1.2 +++ telnetbbs/telnetbbs.pl 2010/12/17 20:15:24 1.10 @@ -6,14 +6,13 @@ ## ## Nicholas DeClario ## October 2009 -## $Id: telnetbbs.pl,v 1.2 2010/01/06 13:33:19 nick Exp $ +## $Id: telnetbbs.pl,v 1.10 2010/12/17 20:15:24 nick Exp $ ## ################################################################################ BEGIN { delete @ENV{qw(IFS CDPATH ENV BASH_ENV PATH)}; $ENV{PATH} = "/bin:/usr/bin"; $|++; -# Flip this back on for more detailed error reporting # $SIG{__DIE__} = sub { require Carp; Carp::confess(@_); } } @@ -30,18 +29,35 @@ use threads; use threads::shared; ## -## Fetch our command line options +## Fetch our command line and configuration options ## my %opts = &fetchOptions( ); -my $pidFile = "/var/run/telnetbbs.pid"; +my %cfg = &fetchConfig( ); my $EOL = "\015\012"; -my $BBS_NAME = "Hell's Dominion BBS"; + +## +## These are read in from the config file +## +my $BBS_NODE = 0; +my $pidFile = $cfg{'pidfile'} || "/tmp/telnetbbs.pid"; +my $port = $opts{'port'} || $cfg{'port'} || 23; +my $DISPLAY = $cfg{'display'} || ":0.0"; +my $BBS_NAME = $cfg{'bbs_name'} || "Hell's Dominion BBS"; +my $DBCONF = $cfg{'dosbox_cfg'} || "/tmp/dosbox-__NODE__.conf"; +my $BBS_CMD = $cfg{'bbs_cmd'} || "DISPLAY=__DISPLAY__ /usr/bin/dosbox -conf "; +my $LOGGING = $cfg{'logging'} || 0; +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"; + $BBS_CMD =~ s/__DISPLAY__/$DISPLAY/g; ## ## Check that we are 'root' ## die( "Must be root user to run this.\n" ) - if ( getpwuid( $> ) ne "root" ); + if ( getpwuid( $> ) ne "root" && $port < 1023 ); ## ## Check for a PID @@ -60,9 +76,22 @@ $SIG{CHLD} = 'IGNORE'; local $SIG{HUP} = $SIG{INT} = $SIG{TERM} = \&shutdown; ## +## Open the Log +## +open LOG, ">>$LOG" if ( $LOGGING ); +&logmsg( "Starting telnetbbs server" ); + +## +## Display running information +## +&display_config_and_options( \%opts, "Options" ); +&display_config_and_options( \%cfg, "Configuration" ); + +## ## Start the network server ## -my $netThread = threads->create( \&startNetServer ); +my $netThread = threads->create( \&startNetServer( ) ); + while( 1 ) { sleep 1; } @@ -77,9 +106,46 @@ while( 1 ) { sleep 1; } ## 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 $$: @_ at ", scalar localtime, "\n" } + return $hr if ( ! $hr ); + + print LOG $title . Dumper( $hr ) if ( $LOGGING ); + print STDOUT $title . Dumper( $hr ) if ( $opts{'verbose'}); +} ############################################################################### ## startNetServer( ); @@ -92,8 +158,7 @@ sub startNetServer { my $hostConnection; my $childPID; - my $port = $opts{'port'} || 23; - my $node = 1; + my @nodes = ( ); my $server = IO::Socket::INET->new( LocalPort => $port, @@ -111,6 +176,49 @@ sub startNetServer ## REQUEST: while( $hostConnection = $server->accept( ) ) { + ## + ## Find the next available node + ## + my $node = 0; + my $lock_file = ""; + my $cnt = 0; + while ( ! $node && $cnt < $MAX_NODE ) + { + $cnt++; + $lock_file = $LOCK_PATH . "/" . $BBS_NAME . + "_node" . $cnt . ".lock"; +print "Checking for node lock: $lock_file\n"; + next if ( -f $lock_file ); + + ## + ## Create node lock file + ## + open LOCK, ">$lock_file"; + close( LOCK ); + $BBS_NODE = $node = $cnt; +print "Using node: $node\n"; + } + + ## + ## Create our dosbox config + ## + open( DBT, "<$DOSBOXT" ); + my @dbt = ; + close( DBT ); + + my $bpn = $BASE_PORT + $BBS_NODE; + $DBCONF =~ s/__NODE__/$BBS_NODE/g; + open( DBC, ">$DBCONF" ); + foreach( @dbt ) + { + $_ =~ s/__NODE__/$BBS_NODE/g; + $_ =~ s/__LISTEN_PORT__/$bpn/g; + print DBC $_; + } + close( DBC ); + + &logmsg( "Connecting on node $BBS_NODE\n" ); + my $kidpid; my $line; @@ -120,13 +228,23 @@ sub startNetServer } defined( $childPID ) || die( "Cannot fork: $!\n" ); + select $hostConnection; + ## ## Default file descriptor to the client and turn on autoflush ## $hostConnection->autoflush( 1 ); - print $hostConnection "Welcome to $BBS_NAME!" . $EOL; - print $hostConnection "Starting BBS on node $node...$EOL"; + print "Welcome to $BBS_NAME!" . $EOL; + + ## + if ( ! $node ) + { + print "No available nodes. Try again later.".$EOL; + exit; + } + + print "Starting BBS on node $BBS_NODE...$EOL"; ## ## Launch BBS via dosbox @@ -134,18 +252,35 @@ sub startNetServer my $bbsPID = fork( ); if ( $bbsPID ) { - exec( "dosbox" ); + select STDOUT; + my $cmd = $BBS_CMD . $DBCONF; + system( $cmd ); + print "Shutting down node $BBS_NODE\n"; + + ## + ## Remove Lock + ## + unlink( $lock_file ); + unlink( $DBCONF ); + close( $hostConnection ); + close( $server ); + kill( "TERM" => $bbsPID ); exit; } - sleep 10; + + ## + ## We wait for dosbox to start and the BBS to start + ## There really should be a better way to determine this + ## + sleep 5; ## ## Create connection to BBS ## my $bbs = IO::Socket::INET->new ( PeerAddr => 'localhost', - Type => SOCK_STREAM, - PeerPort => 5000, + Type => SOCK_STREAM, + PeerPort => $bpn, Proto => 'tcp', ) || die "Could not open BBS socket: $!\n"; $bbs->autoflush( 1 ); @@ -159,7 +294,8 @@ sub startNetServer { print $hostConnection $byte; } - kill( "TERM" => $childPID ); + $nodes[$BBS_NODE] = 0; + kill( "TERM" => $kidpid ); } else { @@ -169,11 +305,13 @@ sub startNetServer print $bbs $byte; } } + + unlink( $DBCONF ); } close( $hostConnection ); - exit; - close( $server ); + + exit; } ############################################################################### @@ -189,15 +327,31 @@ sub shutdown { my $signame = shift || 0; - print "$0: Shutdown (SIG$signame) received.\n" + select STDOUT; + + &logmsg( "$0: Shutdown (SIG$signame) received.\n" ) if( $signame ); + ## + ## Close Log + ## + close( LOG ) if ( $LOGGING ); + ## ## Remove the PID ## 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 ## # $netThread->detach( ); @@ -306,6 +460,64 @@ sub processExists return 0; } +############################################################################### +## +## %config_hash = &fetchConfig( ); +## +## This reads in a file in the format of "key = value" and stores them +## in to a hash of $hash{$key} = $value. Lines starting with '#' are +## considered comments and ignored. +## +############################################################################### +sub fetchConfig +{ + my %conf = ( ); + my $cf = &findConfig; + + if ( $cf ) + { + open( CONF, "<$cf" ) or die ( "Error opening $cf: $!\n" ); + while( ) + { + next if ( $_ =~ m/^#/ ); + if ( $_ =~ m/(.*?)=(.*)/ ) + { + my $k = $1; my $v = $2; + $k =~ s/\s+//; + $v =~ s/\s+//; + $conf{$k} = $v; + } + } + close( CONF ); + } + + return %conf; +} + +############################################################################### +## +## my $file = &fetchConfig( ); +## +## This function will look for 'telnetbbs.conf' or whatever was specified +## on the command line. It will search the @paths below for the default +## filename if none is specifed. +## +############################################################################### +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; +} ############################################################################### ## @@ -318,9 +530,11 @@ sub fetchOptions { my %opts; &GetOptions( + "config:s" => \$opts{'config'}, "help|?" => \$opts{'help'}, "man" => \$opts{'man'}, "port:i" => \$opts{'port'}, + "verbose" => \$opts{'verbose'}, ) || &pod2usage( ); &pod2usage( ) if defined $opts{'help'}; &pod2usage( { -verbose => 2, -input => \*DATA } ) if defined $opts{'man'}; @@ -339,9 +553,11 @@ telnetbbs.pl - A telnet server designed telnetbbs.pl [options] Options: + --config,c Specify the configuration file to use --help,? Display the basic help menu --man,m Display the detailed man page --port,p Port to listen on, default 23. + --verbose,v Enable verbose output =head1 DESCRIPTION