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