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