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