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