Annotation of telnetbbs/telnetbbs.pl, revision 1.8
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.8 ! nick 9: ## $Id: telnetbbs.pl,v 1.7 2010-12-16 14:24:25 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.7 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: ##
1.7 nick 39: ## These are read in from the config file
1.3 nick 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: ###############################################################################
1.8 ! nick 108:
! 109:
! 110: ###############################################################################
! 111: ##
! 112: ## &logmsg( "string" );
! 113: ##
! 114: ## This takes a string and prepends the process name, ID and timestamp
! 115: ## to the message. It then displays it to STDOUT and logs it if enabled.
! 116: ##
1.1 nick 117: ###############################################################################
1.6 nick 118: sub logmsg
119: {
120: my $message = "$0 $$ " . scalar( localtime( ) ) . ":@_\n";
121: print STDOUT $message;
122: print LOG $message if ( $LOGGING );
123: }
124:
125:
126: ###############################################################################
1.8 ! nick 127: ##
! 128: ## &display_config_and_options( %hash );
! 129: ##
! 130: ## This will display via Data::Dumper a hash that is passed to it.
! 131: ## If verbose is enabled it will got to STDOUT and if logging is enabled
! 132: ## it will be logged.
! 133: ##
! 134: ## This is called only once during startup.
! 135: ##
1.6 nick 136: ###############################################################################
137: sub display_config_and_options
138: {
139: my $hr = shift || 0;
140: my $name = shift || "Unknown";
141: my $title = "Displaying $name\n";
142:
143: return $hr if ( ! $hr );
144:
145: print LOG $title . Dumper( $hr ) if ( $LOGGING );
146: print STDOUT $title . Dumper( $hr ) if ( $opts{'verbose'});
147: }
1.1 nick 148:
149: ###############################################################################
150: ## startNetServer( );
151: ##
152: ## We want to open the next free port when an incoming connection to the
153: ## main port is made. We need to set that up here.
154: ##
155: ###############################################################################
156: sub startNetServer
157: {
158: my $hostConnection;
159: my $childPID;
1.4 nick 160: my @nodes = ( );
1.1 nick 161:
162: my $server = IO::Socket::INET->new(
163: LocalPort => $port,
164: Type => SOCK_STREAM,
165: Proto => 'tcp',
166: Reuse => 1,
167: Listen => 1,
168: ) or die "Couldn't create socket on port $port: $!\n";
169:
170: &logmsg( "Listening on port $port" );
171:
172: ##
173: ## We want to fork our connection when it's made so that we are ready
174: ## to accept other incoming connections.
175: ##
176: REQUEST: while( $hostConnection = $server->accept( ) )
177: {
1.3 nick 178: ##
179: ## Find the next available node
180: ##
181: my $node = 0;
1.5 nick 182: my $lock_file = "";
1.3 nick 183: foreach (1 .. $MAX_NODE)
184: {
1.5 nick 185: next if ( -f $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock" );
186:
187: ##
188: ## Create node lock file
189: ##
190: $lock_file = $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock";
191: open LOCK, ">$lock_file";
192: close( LOCK );
193: $node = $BBS_NODE = $_;
1.3 nick 194: }
1.4 nick 195:
1.3 nick 196: ##
197: ## Create our dosbox config
198: ##
199: open( DBT, "<$DOSBOXT" );
200: my @dbt = <DBT>;
201: close( DBT );
202:
203: my $bpn = $BASE_PORT + $BBS_NODE;
204: $DBCONF =~ s/__NODE__/$BBS_NODE/g;
205: open( DBC, ">$DBCONF" );
206: foreach( @dbt )
207: {
208: $_ =~ s/__NODE__/$BBS_NODE/g;
209: $_ =~ s/__LISTEN_PORT__/$bpn/g;
210: print DBC $_;
211: }
212: close( DBC );
213:
214: &logmsg( "Connecting on node $BBS_NODE\n" );
215:
1.1 nick 216: my $kidpid;
217: my $line;
218:
219: if( $childPID = fork( ) ) {
220: close( $hostConnection );
221: next REQUEST;
222: }
223: defined( $childPID ) || die( "Cannot fork: $!\n" );
224:
1.5 nick 225: select $hostConnection;
226:
1.1 nick 227: ##
228: ## Default file descriptor to the client and turn on autoflush
229: ##
230: $hostConnection->autoflush( 1 );
231:
1.5 nick 232: print "Welcome to $BBS_NAME!" . $EOL;
1.3 nick 233:
234: ##
1.5 nick 235: if ( ! $lock_file )
1.3 nick 236: {
1.5 nick 237: print "No available nodes. Try again later.".$EOL;
1.3 nick 238: exit;
239: }
240:
1.5 nick 241: print "Starting BBS on node $BBS_NODE...$EOL";
1.1 nick 242:
243: ##
244: ## Launch BBS via dosbox
245: ##
246: my $bbsPID = fork( );
247: if ( $bbsPID )
248: {
1.5 nick 249: select STDOUT;
1.3 nick 250: my $cmd = $BBS_CMD . $DBCONF;
1.5 nick 251: system( $cmd );
252: print "Shutting down node $BBS_NODE\n";
253: ##
254: ## Remove Lock
255: ##
256: unlink( $lock_file );
257: unlink( $DBCONF );
1.1 nick 258: exit;
259: }
1.3 nick 260:
261: ##
262: ## We wait for dosbox to start and the BBS to start
263: ## There really should be a better way to determine this
264: ##
265: sleep 5;
1.1 nick 266:
267: ##
268: ## Create connection to BBS
269: ##
270: my $bbs = IO::Socket::INET->new (
271: PeerAddr => 'localhost',
1.3 nick 272: Type => SOCK_STREAM,
273: PeerPort => $bpn,
1.1 nick 274: Proto => 'tcp',
275: ) || die "Could not open BBS socket: $!\n";
276: $bbs->autoflush( 1 );
277: die "Can't fork BBS connection: $!\n"
278: unless defined( $kidpid = fork( ) );
279:
280: if ( $kidpid )
281: {
282: my $byte;
283: while ( sysread( $bbs, $byte, 1 ) == 1 )
284: {
285: print $hostConnection $byte;
286: }
1.4 nick 287: $nodes[$BBS_NODE] = 0;
288: kill( "TERM" => $kidpid );
1.1 nick 289: }
290: else
291: {
292: my $byte;
293: while( sysread( $hostConnection, $byte, 1 ) == 1 )
294: {
295: print $bbs $byte;
296: }
297: }
1.3 nick 298:
299: unlink( $DBCONF );
1.1 nick 300: }
301: close( $hostConnection );
302: exit;
303:
1.3 nick 304: # close( $server );
1.1 nick 305: }
306:
307: ###############################################################################
308: ##
309: ## shutdown( $signame );
310: ##
311: ## Call our shutdown routine which cleanly kills all the child processes
312: ## and shuts down. Optionally, if a kill signal was received, it will be
313: ## displayed.
314: ##
315: ###############################################################################
316: sub shutdown
317: {
318: my $signame = shift || 0;
319:
1.5 nick 320: select STDOUT;
321:
1.3 nick 322: &logmsg( "$0: Shutdown (SIG$signame) received.\n" )
1.1 nick 323: if( $signame );
324:
1.3 nick 325: ##
326: ## Close Log
327: ##
1.6 nick 328: close( LOG ) if ( $LOGGING );
1.3 nick 329:
1.1 nick 330: ##
331: ## Remove the PID
332: ##
333: unlink( $pidFile );
334:
335: ##
1.7 nick 336: ## Remove node lock files
337: ##
338: foreach (1 .. $MAX_NODE)
339: {
340: my $node_lock = $LOCK_PATH."/".$BBS_NAME."_node".$_.".lock";
341: unlink( $node_lock ) if ( -f $node_lock );
342: }
343:
344: ##
1.1 nick 345: ## Wait for the thread to shutdown
346: ##
347: # $netThread->detach( );
348:
349: ##
350: ## And time to exit
351: ##
352: &POSIX::_exit( 0 );
353: }
354:
355: ###############################################################################
356: ##
357: ## my $result = checkPID( $pidFile );
358: ##
359: ## We need to see if there is a PID file, if so if the PID inside is still
360: ## actually running, if not, re-create the PID file with the new PID.
361: ## If there is no PID file to begin with, we create one.
362: ##
363: ## If this process is successfull a non-zero value is returned.
364: ##
365: ###############################################################################
366: sub checkPID
367: {
368: my $pidFile = shift || return 0;
369: my $pid = 0;
370:
371: ##
372: ## If there is no PID file, create it.
373: ##
374: if ( ! stat( $pidFile ) )
375: {
376: open PF, ">$pidFile" || return 0;
377: print PF $$;
378: close( PF );
379:
380: return 1;
381: }
382: ##
383: ## We have a PID file. If the process does not actually exist, then
384: ## delete the PID file.
385: ##
386: else
387: {
388: open PIDFILE, "<$pidFile" ||
389: die( "Failed ot open PID file: $!\n" );
390: $pid = <PIDFILE>;
391: close( PIDFILE );
392:
393: ##
394: ## Unlink the file if the process doesn't exist
395: ## and continue with execution
396: ##
397: if ( &processExists( $pid, $0 ) )
398: {
399: unlink( $pidFile );
400: open PF, ">$pidFile" || return 0;
401: print PF $$ . "\n";
402: close( PF );
403:
404: return 2;
405: }
406: return 0;
407: }
408: }
409:
410: ###############################################################################
411: ##
412: ## sub processExists( );
413: ##
414: ## Check the '/proc' file system for the process ID number listed in the
415: ## PID file. '/proc/$PID/cmdline' will be compared to the running process
416: ## name. If the process ID does exist but the name does not match we assume
417: ## it's a dead PID file.
418: ##
419: ###############################################################################
420: sub processExists
421: {
422: my $pid = shift || return 0;
423: my $pname = shift || return 0;
424:
425: ##
426: ## If the directory doesn't exist, there is no way the
427: ## process is running
428: ##
429: return 0 if ( ! -f "/proc/$pid" );
430:
431: ##
432: ## However, if the directory does exist, we need to confirm that it is
433: ## indeed the process we are looking.
434: ##
435: open CMD, "</proc/$pid/cmdline";
436: my $cmd = <CMD>;
437: close( CMD );
438:
439: ##
440: ## Filter out leading PATH information
441: ##
442: $pname =~ s/^\.\///;
443: $cmd =~ s/.*\/(.*)/$1/;
444:
445: ##
446: ## if we found the process, return 1
447: ##
448: return 1 if ( $cmd =~ m/$pname/ );
449:
450: return 0;
451: }
452:
1.6 nick 453: ###############################################################################
454: ###############################################################################
455: sub fetchConfig
456: {
457: my %conf = ( );
458: my $cf = &findConfig;
459:
460: if ( $cf )
461: {
462: open( CONF, "<$cf" ) or die ( "Error opening $cf: $!\n" );
463: while( <CONF> )
464: {
465: next if ( $_ =~ m/^#/ );
466: if ( $_ =~ m/(.*?)=(.*)/ )
467: {
468: my $k = $1; my $v = $2;
469: $k =~ s/\s+//;
470: $v =~ s/\s+//;
471: $conf{$k} = $v;
472: }
473: }
474: close( CONF );
475: }
476:
477: return %conf;
478: }
479:
480: ###############################################################################
481: ###############################################################################
482: sub findConfig
483: {
484: my $cf = 0;
485: my @paths = qw| ./ ./.telnetbbs /etc /usr/local/etc |;
486:
1.7 nick 487: return $opts{'config'} if defined $opts{'config'};
488:
1.6 nick 489: foreach ( @paths )
490: {
491: my $fn = $_ . "/telnetbbs.conf";
492: return $fn if ( -f $fn );
493: }
494:
495: return $cf;
496: }
1.1 nick 497:
498: ###############################################################################
499: ##
500: ## &fetchOptions( );
501: ##
502: ## Grab our command line arguments and toss them in to a hash
503: ##
504: ###############################################################################
505: sub fetchOptions {
506: my %opts;
507:
508: &GetOptions(
1.7 nick 509: "config:s" => \$opts{'config'},
1.1 nick 510: "help|?" => \$opts{'help'},
511: "man" => \$opts{'man'},
1.2 nick 512: "port:i" => \$opts{'port'},
1.6 nick 513: "verbose" => \$opts{'verbose'},
1.1 nick 514: ) || &pod2usage( );
515: &pod2usage( ) if defined $opts{'help'};
516: &pod2usage( { -verbose => 2, -input => \*DATA } ) if defined $opts{'man'};
517:
518: return %opts;
519: }
520:
521: __END__
522:
523: =head1 NAME
524:
1.2 nick 525: telnetbbs.pl - A telnet server designed to launch a multi-node BBS.
1.1 nick 526:
527: =head1 SYNOPSIS
528:
1.2 nick 529: telnetbbs.pl [options]
1.1 nick 530:
531: Options:
1.7 nick 532: --config,c Specify the configuration file to use
1.1 nick 533: --help,? Display the basic help menu
534: --man,m Display the detailed man page
1.2 nick 535: --port,p Port to listen on, default 23.
1.7 nick 536: --verbose,v Enable verbose output
1.1 nick 537:
538: =head1 DESCRIPTION
539:
540: =head1 HISTORY
541:
542: =head1 AUTHOR
543:
544: Nicholas DeClario <nick@declario.com>
545:
546: =head1 BUGS
547:
548: This is a work in progress. Please report all bugs to the author.
549:
550: =head1 SEE ALSO
551:
552: =head1 COPYRIGHT
553:
554: =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