Annotation of telnetbbs/telnetbbs.pl, revision 1.6
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
1.6 ! nick 9: ## $Id: telnetbbs.pl,v 1.5 2010-12-13 05:54:50 nick Exp $
1.1 nick 10: ##
11: ################################################################################
12: BEGIN {
13: delete @ENV{qw(IFS CDPATH ENV BASH_ENV PATH)};
14: $ENV{PATH} = "/bin:/usr/bin";
15: $|++;
1.6 ! nick 16: $SIG{__DIE__} = sub { require Carp; Carp::confess(@_); }
1.1 nick 17: }
18:
19: use strict;
20: use Getopt::Long;
21: use Pod::Usage;
22: use Data::Dumper;
23: use POSIX qw/ mkfifo /;
24: use IO::File;
25: use Socket;
26: use IO::Socket::INET;
27: use Time::HiRes qw/ sleep setitimer ITIMER_REAL time /;
28: use threads;
29: use threads::shared;
30:
31: ##
1.6 ! nick 32: ## Fetch our command line and configuration options
1.1 nick 33: ##
34: my %opts = &fetchOptions( );
1.6 ! nick 35: my %cfg = &fetchConfig( );
1.1 nick 36: my $EOL = "\015\012";
1.3 nick 37:
38: ##
39: ## These will be moved in to a config file
40: ##
1.5 nick 41: my $BBS_NODE = 0;
1.6 ! nick 42: my $pidFile = $cfg{'pidfile'} || "/tmp/telnetbbs.pid";
! 43: my $port = $opts{'port'} || $cfg{'port'} || 23;
! 44: my $DISPLAY = $cfg{'display'} || ":0.0";
! 45: my $BBS_NAME = $cfg{'bbs_name'} || "Hell's Dominion BBS";
! 46: my $DBCONF = $cfg{'dosbox_cfg'} || "/tmp/dosbox-__NODE__.conf";
! 47: my $BBS_CMD = $cfg{'bbs_cmd'} || "DISPLAY=$DISPLAY /usr/bin/dosbox -conf ";
! 48: my $LOGGING = $cfg{'logging'} || 0;
! 49: my $LOG = $cfg{'log_path'} || "/tmp/bbs.log";
! 50: my $MAX_NODE = $cfg{'nodes'} || 1;
! 51: my $DOSBOXT = $cfg{'dosboxt'} || "dosbox.conf.template";
! 52: my $BASE_PORT = $cfg{'base_port'} || 7000;
! 53: my $LOCK_PATH = $cfg{'lock_path'} || "/tmp";
1.1 nick 54:
55: ##
56: ## Check that we are 'root'
57: ##
58: die( "Must be root user to run this.\n" )
1.6 ! nick 59: if ( getpwuid( $> ) ne "root" && $port < 1023 );
1.1 nick 60:
61: ##
62: ## Check for a PID
63: ##
64: exit( 255 ) if ( ! &checkPID( $pidFile ) );
65:
66: ##
67: ## Lets keep an eye on the forked children our network socket will be using
68: ##
69: $SIG{CHLD} = 'IGNORE';
70:
71: ##
72: ## Catch any type of kill signals so that we may cleanly shutdown. These
73: ## include 'kill', 'kill -HUP' and a 'CTRL-C' from the keyboard.
74: ##
75: local $SIG{HUP} = $SIG{INT} = $SIG{TERM} = \&shutdown;
76:
77: ##
1.3 nick 78: ## Open the Log
79: ##
1.6 ! nick 80: open LOG, ">>$LOG" if ( $LOGGING );
1.3 nick 81: &logmsg( "Starting telnetbbs server" );
82:
83: ##
1.6 ! nick 84: ## Display running information
! 85: ##
! 86: &display_config_and_options( \%opts, "Options" );
! 87: &display_config_and_options( \%cfg, "Configuration" );
! 88:
! 89: ##
1.1 nick 90: ## Start the network server
91: ##
1.4 nick 92: my $netThread = threads->create( \&startNetServer( ) );
93:
1.1 nick 94:
95: while( 1 ) { sleep 1; }
96:
97: ##
98: ## If we made it here, the main loop died, lets shutdown
99: ##
100: &shutdown( );
101:
102: ###############################################################################
103: ###############################################################################
104: ##
105: ## Sub-routines begin here
106: ##
107: ###############################################################################
108: ###############################################################################
109:
1.6 ! nick 110: sub logmsg
! 111: {
! 112: my $message = "$0 $$ " . scalar( localtime( ) ) . ":@_\n";
! 113: print STDOUT $message;
! 114: print LOG $message if ( $LOGGING );
! 115: }
! 116:
! 117:
! 118: ###############################################################################
! 119: ###############################################################################
! 120: sub display_config_and_options
! 121: {
! 122: my $hr = shift || 0;
! 123: my $name = shift || "Unknown";
! 124: my $title = "Displaying $name\n";
! 125:
! 126: return $hr if ( ! $hr );
! 127:
! 128: print LOG $title . Dumper( $hr ) if ( $LOGGING );
! 129: print STDOUT $title . Dumper( $hr ) if ( $opts{'verbose'});
! 130: }
1.1 nick 131:
132: ###############################################################################
133: ## startNetServer( );
134: ##
135: ## We want to open the next free port when an incoming connection to the
136: ## main port is made. We need to set that up here.
137: ##
138: ###############################################################################
139: sub startNetServer
140: {
141: my $hostConnection;
142: my $childPID;
1.4 nick 143: my @nodes = ( );
1.1 nick 144:
145: my $server = IO::Socket::INET->new(
146: LocalPort => $port,
147: Type => SOCK_STREAM,
148: Proto => 'tcp',
149: Reuse => 1,
150: Listen => 1,
151: ) or die "Couldn't create socket on port $port: $!\n";
152:
153: &logmsg( "Listening on port $port" );
154:
155: ##
156: ## We want to fork our connection when it's made so that we are ready
157: ## to accept other incoming connections.
158: ##
159: REQUEST: while( $hostConnection = $server->accept( ) )
160: {
1.3 nick 161: ##
162: ## Find the next available node
163: ##
164: my $node = 0;
1.5 nick 165: my $lock_file = "";
1.3 nick 166: foreach (1 .. $MAX_NODE)
167: {
1.5 nick 168: print "Searching for lock: " . $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock\n";
169: next if ( -f $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock" );
170:
171: ##
172: ## Create node lock file
173: ##
174: $lock_file = $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock";
175: open LOCK, ">$lock_file";
176: close( LOCK );
177: $node = $BBS_NODE = $_;
1.3 nick 178: }
1.5 nick 179: print "Using lock: " . $LOCK_PATH."/".$BBS_NAME."_node".$node.".lock\n";
1.4 nick 180:
1.3 nick 181: ##
182: ## Create our dosbox config
183: ##
184: open( DBT, "<$DOSBOXT" );
185: my @dbt = <DBT>;
186: close( DBT );
187:
188: my $bpn = $BASE_PORT + $BBS_NODE;
189: $DBCONF =~ s/__NODE__/$BBS_NODE/g;
190: open( DBC, ">$DBCONF" );
191: foreach( @dbt )
192: {
193: $_ =~ s/__NODE__/$BBS_NODE/g;
194: $_ =~ s/__LISTEN_PORT__/$bpn/g;
195: print DBC $_;
196: }
197: close( DBC );
198:
199: &logmsg( "Connecting on node $BBS_NODE\n" );
200:
1.1 nick 201: my $kidpid;
202: my $line;
203:
204: if( $childPID = fork( ) ) {
205: close( $hostConnection );
206: next REQUEST;
207: }
208: defined( $childPID ) || die( "Cannot fork: $!\n" );
209:
1.5 nick 210: select $hostConnection;
211:
1.1 nick 212: ##
213: ## Default file descriptor to the client and turn on autoflush
214: ##
215: $hostConnection->autoflush( 1 );
216:
1.5 nick 217: print "Welcome to $BBS_NAME!" . $EOL;
1.3 nick 218:
219: ##
1.5 nick 220: if ( ! $lock_file )
1.3 nick 221: {
1.5 nick 222: print "No available nodes. Try again later.".$EOL;
1.3 nick 223: exit;
224: }
225:
1.5 nick 226: print "Starting BBS on node $BBS_NODE...$EOL";
1.1 nick 227:
228: ##
229: ## Launch BBS via dosbox
230: ##
231: my $bbsPID = fork( );
232: if ( $bbsPID )
233: {
1.5 nick 234: select STDOUT;
1.3 nick 235: my $cmd = $BBS_CMD . $DBCONF;
1.5 nick 236: system( $cmd );
237: print "Shutting down node $BBS_NODE\n";
238: ##
239: ## Remove Lock
240: ##
241: unlink( $lock_file );
242: unlink( $DBCONF );
1.1 nick 243: exit;
244: }
1.3 nick 245:
246: ##
247: ## We wait for dosbox to start and the BBS to start
248: ## There really should be a better way to determine this
249: ##
250: sleep 5;
1.1 nick 251:
252: ##
253: ## Create connection to BBS
254: ##
255: my $bbs = IO::Socket::INET->new (
256: PeerAddr => 'localhost',
1.3 nick 257: Type => SOCK_STREAM,
258: PeerPort => $bpn,
1.1 nick 259: Proto => 'tcp',
260: ) || die "Could not open BBS socket: $!\n";
261: $bbs->autoflush( 1 );
262: die "Can't fork BBS connection: $!\n"
263: unless defined( $kidpid = fork( ) );
264:
265: if ( $kidpid )
266: {
267: my $byte;
268: while ( sysread( $bbs, $byte, 1 ) == 1 )
269: {
270: print $hostConnection $byte;
271: }
1.4 nick 272: $nodes[$BBS_NODE] = 0;
273: kill( "TERM" => $kidpid );
1.1 nick 274: }
275: else
276: {
277: my $byte;
278: while( sysread( $hostConnection, $byte, 1 ) == 1 )
279: {
280: print $bbs $byte;
281: }
282: }
1.3 nick 283:
284: unlink( $DBCONF );
1.1 nick 285: }
286: close( $hostConnection );
287: exit;
288:
1.3 nick 289: # close( $server );
1.1 nick 290: }
291:
292: ###############################################################################
293: ##
294: ## shutdown( $signame );
295: ##
296: ## Call our shutdown routine which cleanly kills all the child processes
297: ## and shuts down. Optionally, if a kill signal was received, it will be
298: ## displayed.
299: ##
300: ###############################################################################
301: sub shutdown
302: {
303: my $signame = shift || 0;
304:
1.5 nick 305: select STDOUT;
306:
1.3 nick 307: &logmsg( "$0: Shutdown (SIG$signame) received.\n" )
1.1 nick 308: if( $signame );
309:
1.3 nick 310: ##
311: ## Close Log
312: ##
1.6 ! nick 313: close( LOG ) if ( $LOGGING );
1.3 nick 314:
1.1 nick 315: ##
316: ## Remove the PID
317: ##
318: unlink( $pidFile );
319:
320: ##
321: ## Wait for the thread to shutdown
322: ##
323: # $netThread->detach( );
324:
325: ##
326: ## And time to exit
327: ##
328: &POSIX::_exit( 0 );
329: }
330:
331: ###############################################################################
332: ##
333: ## my $result = checkPID( $pidFile );
334: ##
335: ## We need to see if there is a PID file, if so if the PID inside is still
336: ## actually running, if not, re-create the PID file with the new PID.
337: ## If there is no PID file to begin with, we create one.
338: ##
339: ## If this process is successfull a non-zero value is returned.
340: ##
341: ###############################################################################
342: sub checkPID
343: {
344: my $pidFile = shift || return 0;
345: my $pid = 0;
346:
347: ##
348: ## If there is no PID file, create it.
349: ##
350: if ( ! stat( $pidFile ) )
351: {
352: open PF, ">$pidFile" || return 0;
353: print PF $$;
354: close( PF );
355:
356: return 1;
357: }
358: ##
359: ## We have a PID file. If the process does not actually exist, then
360: ## delete the PID file.
361: ##
362: else
363: {
364: open PIDFILE, "<$pidFile" ||
365: die( "Failed ot open PID file: $!\n" );
366: $pid = <PIDFILE>;
367: close( PIDFILE );
368:
369: ##
370: ## Unlink the file if the process doesn't exist
371: ## and continue with execution
372: ##
373: if ( &processExists( $pid, $0 ) )
374: {
375: unlink( $pidFile );
376: open PF, ">$pidFile" || return 0;
377: print PF $$ . "\n";
378: close( PF );
379:
380: return 2;
381: }
382: return 0;
383: }
384: }
385:
386: ###############################################################################
387: ##
388: ## sub processExists( );
389: ##
390: ## Check the '/proc' file system for the process ID number listed in the
391: ## PID file. '/proc/$PID/cmdline' will be compared to the running process
392: ## name. If the process ID does exist but the name does not match we assume
393: ## it's a dead PID file.
394: ##
395: ###############################################################################
396: sub processExists
397: {
398: my $pid = shift || return 0;
399: my $pname = shift || return 0;
400:
401: ##
402: ## If the directory doesn't exist, there is no way the
403: ## process is running
404: ##
405: return 0 if ( ! -f "/proc/$pid" );
406:
407: ##
408: ## However, if the directory does exist, we need to confirm that it is
409: ## indeed the process we are looking.
410: ##
411: open CMD, "</proc/$pid/cmdline";
412: my $cmd = <CMD>;
413: close( CMD );
414:
415: ##
416: ## Filter out leading PATH information
417: ##
418: $pname =~ s/^\.\///;
419: $cmd =~ s/.*\/(.*)/$1/;
420:
421: ##
422: ## if we found the process, return 1
423: ##
424: return 1 if ( $cmd =~ m/$pname/ );
425:
426: return 0;
427: }
428:
1.6 ! nick 429: ###############################################################################
! 430: ###############################################################################
! 431: sub fetchConfig
! 432: {
! 433: my %conf = ( );
! 434: my $cf = &findConfig;
! 435:
! 436: if ( $cf )
! 437: {
! 438: open( CONF, "<$cf" ) or die ( "Error opening $cf: $!\n" );
! 439: while( <CONF> )
! 440: {
! 441: next if ( $_ =~ m/^#/ );
! 442: if ( $_ =~ m/(.*?)=(.*)/ )
! 443: {
! 444: my $k = $1; my $v = $2;
! 445: $k =~ s/\s+//;
! 446: $v =~ s/\s+//;
! 447: $conf{$k} = $v;
! 448: }
! 449: }
! 450: close( CONF );
! 451: }
! 452:
! 453: return %conf;
! 454: }
! 455:
! 456: ###############################################################################
! 457: ###############################################################################
! 458: sub findConfig
! 459: {
! 460: my $cf = 0;
! 461: my @paths = qw| ./ ./.telnetbbs /etc /usr/local/etc |;
! 462:
! 463: foreach ( @paths )
! 464: {
! 465: my $fn = $_ . "/telnetbbs.conf";
! 466: return $fn if ( -f $fn );
! 467: }
! 468:
! 469: return $cf;
! 470: }
1.1 nick 471:
472: ###############################################################################
473: ##
474: ## &fetchOptions( );
475: ##
476: ## Grab our command line arguments and toss them in to a hash
477: ##
478: ###############################################################################
479: sub fetchOptions {
480: my %opts;
481:
482: &GetOptions(
483: "help|?" => \$opts{'help'},
484: "man" => \$opts{'man'},
1.2 nick 485: "port:i" => \$opts{'port'},
1.6 ! nick 486: "verbose" => \$opts{'verbose'},
1.1 nick 487: ) || &pod2usage( );
488: &pod2usage( ) if defined $opts{'help'};
489: &pod2usage( { -verbose => 2, -input => \*DATA } ) if defined $opts{'man'};
490:
491: return %opts;
492: }
493:
494: __END__
495:
496: =head1 NAME
497:
1.2 nick 498: telnetbbs.pl - A telnet server designed to launch a multi-node BBS.
1.1 nick 499:
500: =head1 SYNOPSIS
501:
1.2 nick 502: telnetbbs.pl [options]
1.1 nick 503:
504: Options:
505: --help,? Display the basic help menu
506: --man,m Display the detailed man page
1.2 nick 507: --port,p Port to listen on, default 23.
1.1 nick 508:
509: =head1 DESCRIPTION
510:
511: =head1 HISTORY
512:
513: =head1 AUTHOR
514:
515: Nicholas DeClario <nick@declario.com>
516:
517: =head1 BUGS
518:
519: This is a work in progress. Please report all bugs to the author.
520:
521: =head1 SEE ALSO
522:
523: =head1 COPYRIGHT
524:
525: =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