|
|
| version 1.3, 2010/01/11 05:02:27 | 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 @nodes = ( ); | |
| 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 = ":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 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 $server = IO::Socket::INET->new( | my $server = IO::Socket::INET->new( |
| LocalPort => $port, | LocalPort => $port, |
| Line 133 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[$_]++; | ## 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 172 sub startNetServer | Line 207 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 231 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 269 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 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 379 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 394 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'}; |