Annotation of telnetbbs/telnetbbs.pl, revision 1.1
1.1 ! nick 1: #!/usr/bin/perl -wT
! 2: ################################################################################
! 3: ##
! 4: ## See end of script for comments and 'pod2man telnetbbs | nroff -man' to
! 5: ## view man page or pod2text telnetbbs for plain text.
! 6: ##
! 7: ## Nicholas DeClario <nick@declario.com>
! 8: ## October 2009
! 9: ## $Id$
! 10: ##
! 11: ################################################################################
! 12: BEGIN {
! 13: delete @ENV{qw(IFS CDPATH ENV BASH_ENV PATH)};
! 14: $ENV{PATH} = "/bin:/usr/bin";
! 15: $|++;
! 16: # Flip this back on for more detailed error reporting
! 17: # $SIG{__DIE__} = sub { require Carp; Carp::confess(@_); }
! 18: }
! 19:
! 20: use strict;
! 21: use Getopt::Long;
! 22: use Pod::Usage;
! 23: use Data::Dumper;
! 24: use POSIX qw/ mkfifo /;
! 25: use IO::File;
! 26: use Socket;
! 27: use IO::Socket::INET;
! 28: use Time::HiRes qw/ sleep setitimer ITIMER_REAL time /;
! 29: use threads;
! 30: use threads::shared;
! 31:
! 32: ##
! 33: ## Fetch our command line options
! 34: ##
! 35: my %opts = &fetchOptions( );
! 36: my $pidFile = "/var/run/telnetbbs.pid";
! 37: my $EOL = "\015\012";
! 38:
! 39: ##
! 40: ## Check that we are 'root'
! 41: ##
! 42: die( "Must be root user to run this.\n" )
! 43: if ( getpwuid( $> ) ne "root" );
! 44:
! 45: ##
! 46: ## Check for a PID
! 47: ##
! 48: exit( 255 ) if ( ! &checkPID( $pidFile ) );
! 49:
! 50: ##
! 51: ## Lets keep an eye on the forked children our network socket will be using
! 52: ##
! 53: $SIG{CHLD} = 'IGNORE';
! 54:
! 55: ##
! 56: ## Catch any type of kill signals so that we may cleanly shutdown. These
! 57: ## include 'kill', 'kill -HUP' and a 'CTRL-C' from the keyboard.
! 58: ##
! 59: local $SIG{HUP} = $SIG{INT} = $SIG{TERM} = \&shutdown;
! 60:
! 61: ##
! 62: ## Start the network server
! 63: ##
! 64: my $netThread = threads->create( \&startNetServer );
! 65:
! 66: while( 1 ) { sleep 1; }
! 67:
! 68: ##
! 69: ## If we made it here, the main loop died, lets shutdown
! 70: ##
! 71: &shutdown( );
! 72:
! 73: ###############################################################################
! 74: ###############################################################################
! 75: ##
! 76: ## Sub-routines begin here
! 77: ##
! 78: ###############################################################################
! 79: ###############################################################################
! 80:
! 81: sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
! 82:
! 83: ###############################################################################
! 84: ## startNetServer( );
! 85: ##
! 86: ## We want to open the next free port when an incoming connection to the
! 87: ## main port is made. We need to set that up here.
! 88: ##
! 89: ###############################################################################
! 90: sub startNetServer
! 91: {
! 92: my $hostConnection;
! 93: my $childPID;
! 94: my $port = $opts{'port'};
! 95: my $node = 1;
! 96:
! 97: my $server = IO::Socket::INET->new(
! 98: LocalPort => $port,
! 99: Type => SOCK_STREAM,
! 100: Proto => 'tcp',
! 101: Reuse => 1,
! 102: Listen => 1,
! 103: ) or die "Couldn't create socket on port $port: $!\n";
! 104:
! 105: &logmsg( "Listening on port $port" );
! 106:
! 107: ##
! 108: ## We want to fork our connection when it's made so that we are ready
! 109: ## to accept other incoming connections.
! 110: ##
! 111: REQUEST: while( $hostConnection = $server->accept( ) )
! 112: {
! 113: my $kidpid;
! 114: my $line;
! 115:
! 116: if( $childPID = fork( ) ) {
! 117: close( $hostConnection );
! 118: next REQUEST;
! 119: }
! 120: defined( $childPID ) || die( "Cannot fork: $!\n" );
! 121:
! 122: ##
! 123: ## Default file descriptor to the client and turn on autoflush
! 124: ##
! 125: $hostConnection->autoflush( 1 );
! 126:
! 127: print $hostConnection "Welcome to Hell's Dominion BBS!" . $EOL;
! 128: print $hostConnection "Starting BBS on node $node...$EOL";
! 129:
! 130: ##
! 131: ## Launch BBS via dosbox
! 132: ##
! 133: my $bbsPID = fork( );
! 134: if ( $bbsPID )
! 135: {
! 136: exec( "dosbox" );
! 137: exit;
! 138: }
! 139: sleep 10;
! 140:
! 141: ##
! 142: ## Create connection to BBS
! 143: ##
! 144: my $bbs = IO::Socket::INET->new (
! 145: PeerAddr => 'localhost',
! 146: Type => SOCK_STREAM,
! 147: PeerPort => 5000,
! 148: Proto => 'tcp',
! 149: ) || die "Could not open BBS socket: $!\n";
! 150: $bbs->autoflush( 1 );
! 151: die "Can't fork BBS connection: $!\n"
! 152: unless defined( $kidpid = fork( ) );
! 153:
! 154: if ( $kidpid )
! 155: {
! 156: my $byte;
! 157: while ( sysread( $bbs, $byte, 1 ) == 1 )
! 158: {
! 159: print $hostConnection $byte;
! 160: }
! 161: kill( "TERM" => $childPID );
! 162: }
! 163: else
! 164: {
! 165: my $byte;
! 166: while( sysread( $hostConnection, $byte, 1 ) == 1 )
! 167: {
! 168: print $bbs $byte;
! 169: }
! 170: }
! 171: }
! 172: close( $hostConnection );
! 173: exit;
! 174:
! 175: close( $server );
! 176: }
! 177:
! 178: ###############################################################################
! 179: ##
! 180: ## shutdown( $signame );
! 181: ##
! 182: ## Call our shutdown routine which cleanly kills all the child processes
! 183: ## and shuts down. Optionally, if a kill signal was received, it will be
! 184: ## displayed.
! 185: ##
! 186: ###############################################################################
! 187: sub shutdown
! 188: {
! 189: my $signame = shift || 0;
! 190:
! 191: print "$0: Shutdown (SIG$signame) received.\n"
! 192: if( $signame );
! 193:
! 194: ##
! 195: ## Remove the PID
! 196: ##
! 197: unlink( $pidFile );
! 198:
! 199: ##
! 200: ## Wait for the thread to shutdown
! 201: ##
! 202: # $netThread->detach( );
! 203:
! 204: ##
! 205: ## And time to exit
! 206: ##
! 207: &POSIX::_exit( 0 );
! 208: }
! 209:
! 210: ###############################################################################
! 211: ##
! 212: ## my $result = checkPID( $pidFile );
! 213: ##
! 214: ## We need to see if there is a PID file, if so if the PID inside is still
! 215: ## actually running, if not, re-create the PID file with the new PID.
! 216: ## If there is no PID file to begin with, we create one.
! 217: ##
! 218: ## If this process is successfull a non-zero value is returned.
! 219: ##
! 220: ###############################################################################
! 221: sub checkPID
! 222: {
! 223: my $pidFile = shift || return 0;
! 224: my $pid = 0;
! 225:
! 226: ##
! 227: ## If there is no PID file, create it.
! 228: ##
! 229: if ( ! stat( $pidFile ) )
! 230: {
! 231: open PF, ">$pidFile" || return 0;
! 232: print PF $$;
! 233: close( PF );
! 234:
! 235: return 1;
! 236: }
! 237: ##
! 238: ## We have a PID file. If the process does not actually exist, then
! 239: ## delete the PID file.
! 240: ##
! 241: else
! 242: {
! 243: open PIDFILE, "<$pidFile" ||
! 244: die( "Failed ot open PID file: $!\n" );
! 245: $pid = <PIDFILE>;
! 246: close( PIDFILE );
! 247:
! 248: ##
! 249: ## Unlink the file if the process doesn't exist
! 250: ## and continue with execution
! 251: ##
! 252: if ( &processExists( $pid, $0 ) )
! 253: {
! 254: unlink( $pidFile );
! 255: open PF, ">$pidFile" || return 0;
! 256: print PF $$ . "\n";
! 257: close( PF );
! 258:
! 259: return 2;
! 260: }
! 261: return 0;
! 262: }
! 263: }
! 264:
! 265: ###############################################################################
! 266: ##
! 267: ## sub processExists( );
! 268: ##
! 269: ## Check the '/proc' file system for the process ID number listed in the
! 270: ## PID file. '/proc/$PID/cmdline' will be compared to the running process
! 271: ## name. If the process ID does exist but the name does not match we assume
! 272: ## it's a dead PID file.
! 273: ##
! 274: ###############################################################################
! 275: sub processExists
! 276: {
! 277: my $pid = shift || return 0;
! 278: my $pname = shift || return 0;
! 279:
! 280: ##
! 281: ## If the directory doesn't exist, there is no way the
! 282: ## process is running
! 283: ##
! 284: return 0 if ( ! -f "/proc/$pid" );
! 285:
! 286: ##
! 287: ## However, if the directory does exist, we need to confirm that it is
! 288: ## indeed the process we are looking.
! 289: ##
! 290: open CMD, "</proc/$pid/cmdline";
! 291: my $cmd = <CMD>;
! 292: close( CMD );
! 293:
! 294: ##
! 295: ## Filter out leading PATH information
! 296: ##
! 297: $pname =~ s/^\.\///;
! 298: $cmd =~ s/.*\/(.*)/$1/;
! 299:
! 300: ##
! 301: ## if we found the process, return 1
! 302: ##
! 303: return 1 if ( $cmd =~ m/$pname/ );
! 304:
! 305: return 0;
! 306: }
! 307:
! 308:
! 309: ###############################################################################
! 310: ##
! 311: ## &fetchOptions( );
! 312: ##
! 313: ## Grab our command line arguments and toss them in to a hash
! 314: ##
! 315: ###############################################################################
! 316: sub fetchOptions {
! 317: my %opts;
! 318:
! 319: &GetOptions(
! 320: "help|?" => \$opts{'help'},
! 321: "man" => \$opts{'man'},
! 322: "port:i" => \$opts{'port'},
! 323: ) || &pod2usage( );
! 324: &pod2usage( ) if defined $opts{'help'};
! 325: &pod2usage( { -verbose => 2, -input => \*DATA } ) if defined $opts{'man'};
! 326:
! 327: return %opts;
! 328: }
! 329:
! 330: __END__
! 331:
! 332: =head1 NAME
! 333:
! 334: masterbuild.pl - blurb
! 335:
! 336: =head1 SYNOPSIS
! 337:
! 338: masterbuild.pl [options]
! 339:
! 340: Options:
! 341: --help,? Display the basic help menu
! 342: --man,m Display the detailed man page
! 343:
! 344: =head1 DESCRIPTION
! 345:
! 346: =head1 HISTORY
! 347:
! 348: =head1 AUTHOR
! 349:
! 350: Nicholas DeClario <nick@declario.com>
! 351:
! 352: =head1 BUGS
! 353:
! 354: This is a work in progress. Please report all bugs to the author.
! 355:
! 356: =head1 SEE ALSO
! 357:
! 358: =head1 COPYRIGHT
! 359:
! 360: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to telnetbbs.pl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Local Repository] / telnetbbs