Return to telnetbbs.pl CVS log

Up to [Local Repository] / telnetbbs

Added the ability to specify the configuration file on the command line.
When the service is shutdown cleanly it will now remove all node locks.

Updated the documentation in the configuration file to reflect these
changes.

#!/usr/bin/perl -wT
################################################################################
##
## See end of script for comments and 'pod2man telnetbbs | nroff -man' to
## view man page or pod2text telnetbbs for plain text.
##
##   Nicholas DeClario <nick@declario.com>
##   October 2009
##	$Id: telnetbbs.pl,v 1.7 2010/12/16 14:24:25 nick Exp $
##
################################################################################
BEGIN {
        delete @ENV{qw(IFS CDPATH ENV BASH_ENV PATH)};
        $ENV{PATH} = "/bin:/usr/bin";
        $|++;
#        $SIG{__DIE__} = sub { require Carp; Carp::confess(@_); }
      }

use strict;
use Getopt::Long;
use Pod::Usage;
use Data::Dumper;
use POSIX qw/ mkfifo /;
use IO::File;
use Socket;
use IO::Socket::INET;
use Time::HiRes qw/ sleep setitimer ITIMER_REAL time /;
use threads;
use threads::shared;

##
## Fetch our command line and configuration options
##
my %opts    = &fetchOptions( );
my %cfg     = &fetchConfig( );
my $EOL     = "\015\012";

## 
## 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";

##
## Check that we are 'root' 
##
die( "Must be root user to run this.\n" )
	if ( getpwuid( $> ) ne "root" && $port < 1023 );

##
## Check for a PID
##
exit( 255 ) if ( ! &checkPID( $pidFile ) );

##
## Lets keep an eye on the forked children our network socket will be using
##
$SIG{CHLD} = 'IGNORE';

##
## Catch any type of kill signals so that we may cleanly shutdown.  These
## include 'kill', 'kill -HUP' and a 'CTRL-C' from the keyboard.
##
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( ) );


while( 1 ) { sleep 1; }

##
## If we made it here, the main loop died, lets shutdown
##
&shutdown( );

###############################################################################
###############################################################################
##
## Sub-routines begin here
##
###############################################################################
###############################################################################

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( );
##
##  We want to open the next free port when an incoming connection to the
##  main port is made.  We need to set that up here.
##
###############################################################################
sub startNetServer 
{
	my $hostConnection;
	my $childPID;
	my @nodes = ( );

	my $server = IO::Socket::INET->new( 
			LocalPort => $port,
			Type	  => SOCK_STREAM,
			Proto	  => 'tcp',
			Reuse	  => 1,
			Listen	  => 1,
		) or die "Couldn't create socket on port $port: $!\n";
	
	&logmsg( "Listening on port $port" );

        ##
        ## We want to fork our connection when it's made so that we are ready
        ## to accept other incoming connections.
        ##
	REQUEST: while( $hostConnection = $server->accept( ) )
	{
		## 
		## Find the next available node
		##
		my $node = 0;
		my $lock_file = "";
		foreach (1 .. $MAX_NODE)
		{
			next if ( -f $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock" );

			##
			## Create node lock file
			##
			$lock_file = $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock";
			open LOCK, ">$lock_file";
			close( LOCK );
			$node = $BBS_NODE = $_;
		}

		##
		## Create our dosbox config
		##
		open( DBT, "<$DOSBOXT" );
			my @dbt = <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;

		if( $childPID = fork( ) ) {
			close( $hostConnection );
			next REQUEST;
		}
		defined( $childPID ) || die( "Cannot fork: $!\n" );

		select $hostConnection;

		##
		## Default file descriptor to the client and turn on autoflush
		##
		$hostConnection->autoflush( 1 );

		print "Welcome to $BBS_NAME!" . $EOL;

		##
		if ( ! $lock_file ) 
		{
			print "No available nodes.  Try again later.".$EOL;
			exit;
		}

		print "Starting BBS on node $BBS_NODE...$EOL";

		##
		## Launch BBS via dosbox
		##
		my $bbsPID = fork( );
		if ( $bbsPID ) 
		{
			select STDOUT;
			my $cmd = $BBS_CMD . $DBCONF;
			system( $cmd );
			print "Shutting down node $BBS_NODE\n";
			##
			## Remove Lock
			##	
			unlink( $lock_file );
			unlink( $DBCONF );
			exit;
		}

		##
		## 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	=> $bpn,
				Proto		=> 'tcp',
			) || die "Could not open BBS socket: $!\n";
		$bbs->autoflush( 1 );
		die "Can't fork BBS connection: $!\n" 
			unless defined( $kidpid = fork( ) );

		if ( $kidpid ) 
		{
			my $byte;
			while ( sysread( $bbs, $byte, 1 ) == 1 ) 
			{
				print $hostConnection $byte;
			}
			$nodes[$BBS_NODE] = 0;
			kill( "TERM" => $kidpid );
		}
		else 
		{
			my $byte;
			while( sysread( $hostConnection, $byte, 1 ) == 1 )
			{
				print $bbs $byte;
			}
		}

		unlink( $DBCONF );
	}
	close( $hostConnection );
	exit;

#	close( $server );
}

###############################################################################
##
## shutdown( $signame );
##
##  Call our shutdown routine which cleanly kills all the child processes 
##  and shuts down.  Optionally, if a kill signal was received, it will be
##  displayed.
##
###############################################################################
sub shutdown 
{
	my $signame = shift || 0;

	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( );	

	##
	## And time to exit
	##
	&POSIX::_exit( 0 );
}

###############################################################################
##
## my $result = checkPID( $pidFile );
##
##   We need to see if there is a PID file, if so if the PID inside is still
## actually running, if not, re-create the PID file with the new PID.  
## If there is no PID file to begin with, we create one.
##
## If this process is successfull a non-zero value is returned.
##
###############################################################################
sub checkPID
{
	my $pidFile = shift || return 0;
	my $pid     = 0;

        ##
        ## If there is no PID file, create it.
        ##
        if ( ! stat( $pidFile ) ) 
	{
            open PF, ">$pidFile" || return 0;
                print PF $$;
            close( PF );

            return 1;
        }
        ##
        ## We have a PID file.  If the process does not actually exist, then
        ## delete the PID file.
        ##
        else 
	{
        	open PIDFILE, "<$pidFile" || 
			die( "Failed ot open PID file: $!\n" );
          		$pid = <PIDFILE>;
        	close( PIDFILE );

		##
		## Unlink the file if the process doesn't exist 
		## and continue with execution
		##
		if ( &processExists( $pid, $0 ) ) 
		{
			unlink( $pidFile );
			open PF, ">$pidFile" || return 0;
				print PF $$ . "\n";
			close( PF );

			return 2;
		}
            	return 0;
        }
}

###############################################################################
##
## sub processExists( );
##
##	Check the '/proc' file system for the process ID number listed in the
##  PID file.  '/proc/$PID/cmdline' will be compared to the running process
##  name.  If the process ID does exist but the name does not match we assume
##  it's a dead PID file.
##
###############################################################################
sub processExists 
{
	my $pid   = shift || return 0;
	my $pname = shift || return 0;

	##
	## If the directory doesn't exist, there is no way the 
	## process is running
	##
	return 0 if ( ! -f "/proc/$pid" );

	##
	## However, if the directory does exist, we need to confirm that it is
	## indeed the process we are looking.
	##
	open CMD, "</proc/$pid/cmdline";
		my $cmd = <CMD>;
	close( CMD );

	##
	## Filter out leading PATH information
	##
	$pname =~ s/^\.\///;
	$cmd   =~ s/.*\/(.*)/$1/;

	##
	## if we found the process, return 1
	##
	return 1 if ( $cmd =~ m/$pname/ );

	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;
}

###############################################################################
##
## &fetchOptions( );
##
##      Grab our command line arguments and toss them in to a hash
##
###############################################################################
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'};

        return %opts;
}

__END__

=head1 NAME

telnetbbs.pl - A telnet server designed to launch a multi-node BBS.

=head1 SYNOPSIS

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

=head1 HISTORY

=head1 AUTHOR

Nicholas DeClario <nick@declario.com>

=head1 BUGS

This is a work in progress.  Please report all bugs to the author.

=head1 SEE ALSO

=head1 COPYRIGHT

=cut