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