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