![[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
9: ## $Id$
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";
38:
39: ##
40: ## Check that we are 'root'
41: ##
42: die( "Must be root user to run this.\n" )
43: if ( getpwuid( $> ) ne "root" );
44:
45: ##
46: ## Check for a PID
47: ##
48: exit( 255 ) if ( ! &checkPID( $pidFile ) );
49:
50: ##
51: ## Lets keep an eye on the forked children our network socket will be using
52: ##
53: $SIG{CHLD} = 'IGNORE';
54:
55: ##
56: ## Catch any type of kill signals so that we may cleanly shutdown. These
57: ## include 'kill', 'kill -HUP' and a 'CTRL-C' from the keyboard.
58: ##
59: local $SIG{HUP} = $SIG{INT} = $SIG{TERM} = \&shutdown;
60:
61: ##
62: ## Start the network server
63: ##
64: my $netThread = threads->create( \&startNetServer );
65:
66: while( 1 ) { sleep 1; }
67:
68: ##
69: ## If we made it here, the main loop died, lets shutdown
70: ##
71: &shutdown( );
72:
73: ###############################################################################
74: ###############################################################################
75: ##
76: ## Sub-routines begin here
77: ##
78: ###############################################################################
79: ###############################################################################
80:
81: sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
82:
83: ###############################################################################
84: ## startNetServer( );
85: ##
86: ## We want to open the next free port when an incoming connection to the
87: ## main port is made. We need to set that up here.
88: ##
89: ###############################################################################
90: sub startNetServer
91: {
92: my $hostConnection;
93: my $childPID;
94: my $port = $opts{'port'};
95: my $node = 1;
96:
97: my $server = IO::Socket::INET->new(
98: LocalPort => $port,
99: Type => SOCK_STREAM,
100: Proto => 'tcp',
101: Reuse => 1,
102: Listen => 1,
103: ) or die "Couldn't create socket on port $port: $!\n";
104:
105: &logmsg( "Listening on port $port" );
106:
107: ##
108: ## We want to fork our connection when it's made so that we are ready
109: ## to accept other incoming connections.
110: ##
111: REQUEST: while( $hostConnection = $server->accept( ) )
112: {
113: my $kidpid;
114: my $line;
115:
116: if( $childPID = fork( ) ) {
117: close( $hostConnection );
118: next REQUEST;
119: }
120: defined( $childPID ) || die( "Cannot fork: $!\n" );
121:
122: ##
123: ## Default file descriptor to the client and turn on autoflush
124: ##
125: $hostConnection->autoflush( 1 );
126:
127: print $hostConnection "Welcome to Hell's Dominion BBS!" . $EOL;
128: print $hostConnection "Starting BBS on node $node...$EOL";
129:
130: ##
131: ## Launch BBS via dosbox
132: ##
133: my $bbsPID = fork( );
134: if ( $bbsPID )
135: {
136: exec( "dosbox" );
137: exit;
138: }
139: sleep 10;
140:
141: ##
142: ## Create connection to BBS
143: ##
144: my $bbs = IO::Socket::INET->new (
145: PeerAddr => 'localhost',
146: Type => SOCK_STREAM,
147: PeerPort => 5000,
148: Proto => 'tcp',
149: ) || die "Could not open BBS socket: $!\n";
150: $bbs->autoflush( 1 );
151: die "Can't fork BBS connection: $!\n"
152: unless defined( $kidpid = fork( ) );
153:
154: if ( $kidpid )
155: {
156: my $byte;
157: while ( sysread( $bbs, $byte, 1 ) == 1 )
158: {
159: print $hostConnection $byte;
160: }
161: kill( "TERM" => $childPID );
162: }
163: else
164: {
165: my $byte;
166: while( sysread( $hostConnection, $byte, 1 ) == 1 )
167: {
168: print $bbs $byte;
169: }
170: }
171: }
172: close( $hostConnection );
173: exit;
174:
175: close( $server );
176: }
177:
178: ###############################################################################
179: ##
180: ## shutdown( $signame );
181: ##
182: ## Call our shutdown routine which cleanly kills all the child processes
183: ## and shuts down. Optionally, if a kill signal was received, it will be
184: ## displayed.
185: ##
186: ###############################################################################
187: sub shutdown
188: {
189: my $signame = shift || 0;
190:
191: print "$0: Shutdown (SIG$signame) received.\n"
192: if( $signame );
193:
194: ##
195: ## Remove the PID
196: ##
197: unlink( $pidFile );
198:
199: ##
200: ## Wait for the thread to shutdown
201: ##
202: # $netThread->detach( );
203:
204: ##
205: ## And time to exit
206: ##
207: &POSIX::_exit( 0 );
208: }
209:
210: ###############################################################################
211: ##
212: ## my $result = checkPID( $pidFile );
213: ##
214: ## We need to see if there is a PID file, if so if the PID inside is still
215: ## actually running, if not, re-create the PID file with the new PID.
216: ## If there is no PID file to begin with, we create one.
217: ##
218: ## If this process is successfull a non-zero value is returned.
219: ##
220: ###############################################################################
221: sub checkPID
222: {
223: my $pidFile = shift || return 0;
224: my $pid = 0;
225:
226: ##
227: ## If there is no PID file, create it.
228: ##
229: if ( ! stat( $pidFile ) )
230: {
231: open PF, ">$pidFile" || return 0;
232: print PF $$;
233: close( PF );
234:
235: return 1;
236: }
237: ##
238: ## We have a PID file. If the process does not actually exist, then
239: ## delete the PID file.
240: ##
241: else
242: {
243: open PIDFILE, "<$pidFile" ||
244: die( "Failed ot open PID file: $!\n" );
245: $pid = <PIDFILE>;
246: close( PIDFILE );
247:
248: ##
249: ## Unlink the file if the process doesn't exist
250: ## and continue with execution
251: ##
252: if ( &processExists( $pid, $0 ) )
253: {
254: unlink( $pidFile );
255: open PF, ">$pidFile" || return 0;
256: print PF $$ . "\n";
257: close( PF );
258:
259: return 2;
260: }
261: return 0;
262: }
263: }
264:
265: ###############################################################################
266: ##
267: ## sub processExists( );
268: ##
269: ## Check the '/proc' file system for the process ID number listed in the
270: ## PID file. '/proc/$PID/cmdline' will be compared to the running process
271: ## name. If the process ID does exist but the name does not match we assume
272: ## it's a dead PID file.
273: ##
274: ###############################################################################
275: sub processExists
276: {
277: my $pid = shift || return 0;
278: my $pname = shift || return 0;
279:
280: ##
281: ## If the directory doesn't exist, there is no way the
282: ## process is running
283: ##
284: return 0 if ( ! -f "/proc/$pid" );
285:
286: ##
287: ## However, if the directory does exist, we need to confirm that it is
288: ## indeed the process we are looking.
289: ##
290: open CMD, "</proc/$pid/cmdline";
291: my $cmd = <CMD>;
292: close( CMD );
293:
294: ##
295: ## Filter out leading PATH information
296: ##
297: $pname =~ s/^\.\///;
298: $cmd =~ s/.*\/(.*)/$1/;
299:
300: ##
301: ## if we found the process, return 1
302: ##
303: return 1 if ( $cmd =~ m/$pname/ );
304:
305: return 0;
306: }
307:
308:
309: ###############################################################################
310: ##
311: ## &fetchOptions( );
312: ##
313: ## Grab our command line arguments and toss them in to a hash
314: ##
315: ###############################################################################
316: sub fetchOptions {
317: my %opts;
318:
319: &GetOptions(
320: "help|?" => \$opts{'help'},
321: "man" => \$opts{'man'},
322: "port:i" => \$opts{'port'},
323: ) || &pod2usage( );
324: &pod2usage( ) if defined $opts{'help'};
325: &pod2usage( { -verbose => 2, -input => \*DATA } ) if defined $opts{'man'};
326:
327: return %opts;
328: }
329:
330: __END__
331:
332: =head1 NAME
333:
334: masterbuild.pl - blurb
335:
336: =head1 SYNOPSIS
337:
338: masterbuild.pl [options]
339:
340: Options:
341: --help,? Display the basic help menu
342: --man,m Display the detailed man page
343:
344: =head1 DESCRIPTION
345:
346: =head1 HISTORY
347:
348: =head1 AUTHOR
349:
350: Nicholas DeClario <nick@declario.com>
351:
352: =head1 BUGS
353:
354: This is a work in progress. Please report all bugs to the author.
355:
356: =head1 SEE ALSO
357:
358: =head1 COPYRIGHT
359:
360: =cut