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