Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

TCP server eats up CPU when a client disconnects

Status
Not open for further replies.
Kirsle

Kirsle

Programmer
Jan 21, 2006
1,179
US
Hi.

I'm programming a TCP server that follows the protocol of the CyanChat room ( and here's the problem with it: when a client disconnects, the server process starts devouring TONs of CPU (spiking up to 100%)

Here are the relevant bits of code from my module, Net::CyanChat::Server:

Code: 
[gray][i]# start the server[/i][/gray]
[url=http://perldoc.perl.org/functions/sub.html][black][b]sub[/b][/black][/url] [maroon]connect[/maroon] [red]{[/red]
	[url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [red]([/red][blue]$self[/blue][red])[/red] = [blue]@_[/blue][red];[/red]

	[gray][i]# Create the socket.[/i][/gray]
	[blue]$self[/blue]->[red]{[/red]sock[red]}[/red] = IO::Socket::INET->[maroon]new[/maroon] [red]([/red]
		[purple]LocalAddr[/purple] => [blue]$self[/blue]->[red]{[/red]host[red]}[/red],  [gray][i]# cho.cyan.com[/i][/gray]
		[purple]LocalPort[/purple] => [blue]$self[/blue]->[red]{[/red]port[red]}[/red],  [gray][i]# 1813[/i][/gray]
		[purple]Listen[/purple]    => [fuchsia]1[/fuchsia],
		[purple]Reuse[/purple]     => [fuchsia]1[/fuchsia],
	[red])[/red] or [url=http://perldoc.perl.org/functions/die.html][black][b]die[/b][/black][/url] [red]"[/red][purple]Socket error: [blue]$![/blue][/purple][red]"[/red][red];[/red]

	[gray][i]# Create a select object.[/i][/gray]
	[blue]$self[/blue]->[red]{[/red][url=http://perldoc.perl.org/functions/select.html][black][b]select[/b][/black][/url][red]}[/red] = IO::Select->[maroon]new[/maroon] [red]([/red][blue]$self[/blue]->[red]{[/red]sock[red]}[/red][red])[/red][red];[/red]
[red]}[/red]

[gray][i]# send a message to a specific client socket[/i][/gray]
[black][b]sub[/b][/black] [maroon]reply[/maroon] [red]{[/red]
	[black][b]my[/b][/black] [red]([/red][blue]$self[/blue],[blue]$socket[/blue],[blue]$msg[/blue][red])[/red] = [blue]@_[/blue][red];[/red]

	[gray][i]# Send the message.[/i][/gray]
	[url=http://perldoc.perl.org/functions/print.html][black][b]print[/b][/black][/url] [red]"[/red][purple]S: [blue]$msg[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
	[url=http://perldoc.perl.org/functions/eval.html][black][b]eval[/b][/black][/url] [red]{[/red]
		[blue]$socket[/blue]->[maroon]send[/maroon] [red]([/red][red]"[/red][purple][blue]$msg[/blue][purple][b]\x[/b][/purple]0d[purple][b]\x[/b][/purple]0a[/purple][red]"[/red][red])[/red] or [url=http://perldoc.perl.org/functions/do.html][black][b]do[/b][/black][/url] [red]{[/red]
			[gray][i]# He's been disconnected.[/i][/gray]
			[black][b]my[/b][/black] [blue]$id[/blue] = [blue]$socket[/blue]->[maroon]fileno[/maroon][red];[/red]
			[olive][b]if[/b][/olive] [red]([/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]login[red]}[/red][red])[/red] [red]{[/red]
				[gray][i]# Remove him.[/i][/gray]
				[black][b]my[/b][/black] [blue]$user[/blue] = [blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]username[red]}[/red][red];[/red]
				[url=http://perldoc.perl.org/functions/delete.html][black][b]delete[/b][/black][/url] [blue]$self[/blue]->[red]{[/red]who[red]}[/red]->[red]{[/red][blue]$user[/blue][red]}[/red][red];[/red]
				[black][b]delete[/b][/black] [blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red][red];[/red]

				[gray][i]# Broadcast it.[/i][/gray]
				[blue]$self[/blue]->[maroon]broadcast[/maroon] [red]([/red][red]"[/red][purple]31|[blue]$user[/blue]|^3<mistakenly used an unsafe Linking Book without a maintainer's suit *ZZZZZWHAP*>[/purple][red]"[/red][red])[/red][red];[/red]
				[blue]$self[/blue]->[maroon]sendWhoList[/maroon][red]([/red][red])[/red][red];[/red]
			[red]}[/red]

			[blue]$self[/blue]->[red]{[/red][black][b]select[/b][/black][red]}[/red]->[maroon]remove[/maroon] [red]([/red][blue]$socket[/blue][red])[/red][red];[/red]
			[blue]$socket[/blue]->[maroon]close[/maroon][red]([/red][red])[/red][red];[/red]
		[red]}[/red]
	[red]}[/red][red];[/red]

	[olive][b]if[/b][/olive] [red]([/red][blue]$@[/blue][red])[/red] [red]{[/red]
		[url=http://perldoc.perl.org/functions/warn.html][black][b]warn[/b][/black][/url] [red]"[/red][purple]<[blue]$@[/blue]>[/purple][red]"[/red][red];[/red]
		[blue]$self[/blue]->[red]{[/red][black][b]select[/b][/black][red]}[/red]->[maroon]remove[/maroon] [red]([/red][blue]$socket[/blue][red])[/red][red];[/red]
	[red]}[/red]

[red]}[/red]

Here's the server's main event loop, if you need that:

Code: 
[url=http://perldoc.perl.org/functions/sub.html][black][b]sub[/b][/black][/url] [maroon]do_one_loop[/maroon] [red]{[/red]
	[url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [red]([/red][blue]$self[/blue][red])[/red] = [blue]@_[/blue][red];[/red]

	[gray][i]# Look for events.[/i][/gray]
	[black][b]my[/b][/black] [blue]@ready[/blue] = [blue]$self[/blue]->[red]{[/red][url=http://perldoc.perl.org/functions/select.html][black][b]select[/b][/black][/url][red]}[/red]->[maroon]can_read[/maroon][red]([/red][fuchsia].1[/fuchsia][red])[/red][red];[/red]
	[url=http://perldoc.perl.org/functions/return.html][black][b]return[/b][/black][/url] [olive][b]unless[/b][/olive][red]([/red][blue]@ready[/blue][red])[/red][red];[/red]

	[gray][i]# Go through each event.[/i][/gray]
	[olive][b]foreach[/b][/olive] [black][b]my[/b][/black] [blue]$socket[/blue] [red]([/red][blue]@ready[/blue][red])[/red] [red]{[/red]
		[gray][i]# If the listening socket is ready, accept a new connection.[/i][/gray]
		[olive][b]if[/b][/olive] [red]([/red][blue]$socket[/blue] == [blue]$self[/blue]->[red]{[/red]sock[red]}[/red][red])[/red] [red]{[/red]
			[black][b]my[/b][/black] [blue]$new[/blue] = [blue]$self[/blue]->[red]{[/red]sock[red]}[/red]->[maroon]accept[/maroon][red]([/red][red])[/red][red];[/red]
			[blue]$self[/blue]->[red]{[/red][black][b]select[/b][/black][red]}[/red]->[maroon]add[/maroon] [red]([/red][blue]$new[/blue][red])[/red][red];[/red]
			[url=http://perldoc.perl.org/functions/print.html][black][b]print[/b][/black][/url] [blue]$new[/blue]->[maroon]fileno[/maroon] . [red]"[/red][purple]: connected[purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]

			[gray][i]# Setup data for this connection.[/i][/gray]
			[black][b]my[/b][/black] [blue]$nid[/blue] = [blue]$new[/blue]->[maroon]fileno[/maroon][red];[/red]
			[blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$nid[/blue][red]}[/red] = [red]{[/red]
				[purple]level[/purple]    => [fuchsia]0[/fuchsia],
				[purple]announce[/purple] => [fuchsia]0[/fuchsia],
				[purple]nickname[/purple] => [url=http://perldoc.perl.org/functions/undef.html][black][b]undef[/b][/black][/url],
				[purple]username[/purple] => [black][b]undef[/b][/black],
				[purple]login[/purple]    => [fuchsia]0[/fuchsia],
			[red]}[/red][red];[/red]

			[gray][i]# Send a 35.[/i][/gray]
			[black][b]my[/b][/black] [blue]@memlist[/blue] = [red]([/red][red])[/red][red];[/red]
			[olive][b]foreach[/b][/olive] [black][b]my[/b][/black] [blue]$member[/blue] [red]([/red][url=http://perldoc.perl.org/functions/keys.html][black][b]keys[/b][/black][/url] [blue]%[/blue][red]{[/red][blue]$self[/blue]->[red]{[/red]who[red]}[/red][red]}[/red][red])[/red] [red]{[/red]
				[black][b]my[/b][/black] [blue]$addr[/blue] = [blue]$self[/blue]->[red]{[/red]who[red]}[/red]->[red]{[/red][blue]$member[/blue][red]}[/red][red];[/red]
				[url=http://perldoc.perl.org/functions/push.html][black][b]push[/b][/black][/url] [red]([/red][blue]@memlist[/blue],[red]"[/red][purple][blue]$member[/blue],[blue]$addr[/blue][/purple][red]"[/red][red])[/red][red];[/red]
			[red]}[/red]
			[black][b]my[/b][/black] [blue]$mems[/blue] = [url=http://perldoc.perl.org/functions/join.html][black][b]join[/b][/black][/url] [red]([/red][red]'[/red][purple]|[/purple][red]'[/red], [blue]@memlist[/blue][red])[/red][red];[/red]
			[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$new[/blue],[red]"[/red][purple]35|[blue]$mems[/blue][/purple][red]"[/red][red])[/red][red];[/red]
		[red]}[/red]
		[olive][b]else[/b][/olive] [red]{[/red]
			[gray][i]# Get their ID.[/i][/gray]
			[black][b]my[/b][/black] [blue]$id[/blue] = [blue]$socket[/blue]->[maroon]fileno[/maroon][red];[/red]

			[gray][i]# Read their request.[/i][/gray]
			[black][b]my[/b][/black] [blue]$line[/blue] = [red]'[/red][purple][/purple][red]'[/red][red];[/red]
			[blue]$socket[/blue]->[maroon]recv[/maroon] [red]([/red][blue]$line[/blue], [fuchsia]2048[/fuchsia][red])[/red][red];[/red]
			[url=http://perldoc.perl.org/functions/chomp.html][black][b]chomp[/b][/black][/url] [blue]$line[/blue][red];[/red]
			[blue]$line[/blue] =~ [red]s/[/red][purple][purple][b]\r[/b][/purple][/purple][red]/[/red][purple][/purple][red]/[/red][red]ig[/red][red];[/red]
			[blue]$line[/blue] =~ [red]s/[/red][purple][purple][b]\n[/b][/purple][/purple][red]/[/red][purple][/purple][red]/[/red][red]ig[/red][red];[/red]

			[gray][i]# Skip if this line is blank.[/i][/gray]
			[olive][b]next[/b][/olive] [olive][b]if[/b][/olive] [blue]$line[/blue] eq [red]"[/red][purple][/purple][red]"[/red][red];[/red]

			[gray][i]# Go through the events.[/i][/gray]
			[black][b]my[/b][/black] [red]([/red][blue]$cmd[/blue],[blue]@args[/blue][red])[/red] = [url=http://perldoc.perl.org/functions/split.html][black][b]split[/b][/black][/url][red]([/red][red]/[/red][purple][purple][b]\|[/b][/purple][/purple][red]/[/red], [blue]$line[/blue][red])[/red][red];[/red]

			[black][b]print[/b][/black] [red]"[/red][purple]C [blue]$id[/blue]: [blue]$line[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]

			[olive][b]if[/b][/olive] [red]([/red][blue]$cmd[/blue] == [fuchsia]10[/fuchsia][red])[/red] [red]{[/red]
				[gray][i]# 10 = Sending their name.[/i][/gray]
				[olive][b]if[/b][/olive] [red]([/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]announce[red]}[/red][red])[/red] [red]{[/red]
					[black][b]my[/b][/black] [blue]$nick[/blue] = [black][b]join[/b][/black] [red]([/red][red]"[/red][purple]|[/purple][red]"[/red],[blue]@args[/blue][red])[/red][red];[/red]
					[olive][b]if[/b][/olive] [red]([/red]![url=http://perldoc.perl.org/functions/defined.html][black][b]defined[/b][/black][/url] [blue]$nick[/blue][red])[/red] [red]{[/red]
						[gray][i]# No nick defined.[/i][/gray]
						[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$socket[/blue],[red]"[/red][purple]21|3ChatServer|^1No nickname was defined![/purple][red]"[/red][red])[/red][red];[/red]
					[red]}[/red]
					[olive][b]else[/b][/olive] [red]{[/red]
						[gray][i]# Format their username.[/i][/gray]
						[black][b]my[/b][/black] [blue]$user[/blue] = [black][b]join[/b][/black] [red]([/red][red]"[/red][purple][/purple][red]"[/red], [blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]level[red]}[/red], [blue]$nick[/blue][red])[/red][red];[/red]

						[gray][i]# Valid nick?[/i][/gray]
						[olive][b]if[/b][/olive] [red]([/red][url=http://perldoc.perl.org/functions/length.html][black][b]length[/b][/black][/url] [blue]$nick[/blue] <= [fuchsia]20[/fuchsia] && [blue]$nick[/blue] !~ [red]/[/red][purple][purple][b]\|[/b][/purple][/purple][red]/[/red][red])[/red] [red]{[/red]
							[gray][i]# See if the nick isn't already logged on.[/i][/gray]
							[olive][b]if[/b][/olive] [red]([/red][url=http://perldoc.perl.org/functions/exists.html][black][b]exists[/b][/black][/url] [blue]$self[/blue]->[red]{[/red]who[red]}[/red]->[red]{[/red][blue]$user[/blue][red]}[/red][red])[/red] [red]{[/red]
								[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$socket[/blue],[red]"[/red][purple]21|3ChatServer|^1The nickname is already in use.[/purple][red]"[/red][red])[/red][red];[/red]
							[red]}[/red]
							[olive][b]else[/b][/olive] [red]{[/red]
								[gray][i]# Setting another name?[/i][/gray]
								[olive][b]if[/b][/olive] [red]([/red][black][b]length[/b][/black] [blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]username[red]}[/red] > [fuchsia]0[/fuchsia][red])[/red] [red]{[/red]
									[gray][i]# Remove the old.[/i][/gray]
									[black][b]my[/b][/black] [blue]$old[/blue] = [blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]username[red]}[/red][red];[/red]
									[url=http://perldoc.perl.org/functions/delete.html][black][b]delete[/b][/black][/url] [blue]$self[/blue]->[red]{[/red]who[red]}[/red]->[red]{[/red][blue]$old[/blue][red]}[/red][red];[/red]
								[red]}[/red]

								[gray][i]# Make up their join message.[/i][/gray]
								[black][b]my[/b][/black] [blue]$join[/blue] = [red]"[/red][purple]somewhere on the internet Age[/purple][red]"[/red][red];[/red]

								[gray][i]# Staff?[/i][/gray]
								[olive][b]if[/b][/olive] [red]([/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]level[red]}[/red] == [fuchsia]1[/fuchsia][red])[/red] [red]{[/red]
									[blue]$join[/blue] = [red]"[/red][purple]Cyan Worlds, Inc.[/purple][red]"[/red][red];[/red]
								[red]}[/red]

								[gray][i]# Join them.[/i][/gray]
								[blue]$self[/blue]->[red]{[/red]who[red]}[/red]->[red]{[/red][blue]$user[/blue][red]}[/red] = [blue]$socket[/blue]->[maroon]peerhost[/maroon][red];[/red]
								[blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]username[red]}[/red] = [blue]$user[/blue][red];[/red]
								[blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]nickname[red]}[/red] = [blue]$nick[/blue][red];[/red]
								[blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]login[red]}[/red] = [fuchsia]1[/fuchsia][red];[/red]
								[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$socket[/blue],[red]"[/red][purple]11[/purple][red]"[/red][red])[/red][red];[/red] [gray][i]# 11 = name accepted[/i][/gray]
								[blue]$self[/blue]->[maroon]broadcast[/maroon] [red]([/red][red]"[/red][purple]31|[blue]$user[/blue]|^2<links in from [blue]$join[/blue]>[/purple][red]"[/red][red])[/red][red];[/red]

								[gray][i]# Update the Who List.[/i][/gray]
								[blue]$self[/blue]->[maroon]sendWhoList[/maroon][red]([/red][red])[/red][red];[/red]
							[red]}[/red]
						[red]}[/red]
						[olive][b]else[/b][/olive] [red]{[/red]
							[gray][i]# Invalid nick.[/i][/gray]
							[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$socket[/blue],[red]"[/red][purple]10[/purple][red]"[/red][red])[/red][red];[/red] [gray][i]# 10 = name invalid[/i][/gray]
						[red]}[/red]
					[red]}[/red]
				[red]}[/red]
			[red]}[/red]
			[olive][b]elsif[/b][/olive] [red]([/red][blue]$cmd[/blue] == [fuchsia]15[/fuchsia][red])[/red] [red]{[/red]
				[gray][i]# 15 = Remove their name (sign out).[/i][/gray]
				[olive][b]if[/b][/olive] [red]([/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]login[red]}[/red][red])[/red] [red]{[/red]
					[gray][i]# Exit them.[/i][/gray]
					[black][b]my[/b][/black] [blue]$nick[/blue] = [blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]username[red]}[/red][red];[/red]
					[blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]username[red]}[/red] = [black][b]undef[/b][/black][red];[/red]
					[blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]nickname[red]}[/red] = [black][b]undef[/b][/black][red];[/red]
					[blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]login[red]}[/red] = [fuchsia]0[/fuchsia][red];[/red]
					[black][b]delete[/b][/black] [blue]$self[/blue]->[red]{[/red]who[red]}[/red]->[red]{[/red][blue]$nick[/blue][red]}[/red][red];[/red]
					[blue]$self[/blue]->[maroon]broadcast[/maroon] [red]([/red][red]"[/red][purple]31|[blue]$nick[/blue]|^3<links safely back to their home Age>[/purple][red]"[/red][red])[/red][red];[/red]
					[blue]$self[/blue]->[maroon]sendWhoList[/maroon][red]([/red][red])[/red][red];[/red]
				[red]}[/red]
			[red]}[/red]
			[olive][b]elsif[/b][/olive] [red]([/red][blue]$cmd[/blue] == [fuchsia]20[/fuchsia][red])[/red] [red]{[/red]
				[gray][i]# 20 = send private message.[/i][/gray]
				[olive][b]if[/b][/olive] [red]([/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]login[red]}[/red][red])[/red] [red]{[/red]
					[black][b]my[/b][/black] [blue]$to[/blue] = [url=http://perldoc.perl.org/functions/shift.html][black][b]shift[/b][/black][/url] [blue]@args[/blue][red];[/red]
					[black][b]my[/b][/black] [blue]$msg[/blue] = [black][b]join[/b][/black] [red]([/red][red]"[/red][purple]|[/purple][red]"[/red],[blue]@args[/blue][red])[/red][red];[/red]

					[olive][b]if[/b][/olive] [red]([/red][blue]$to[/blue] && [blue]$msg[/blue][red])[/red] [red]{[/red]
						[gray][i]# Send to this user's socket.[/i][/gray]
						[black][b]my[/b][/black] [blue]$recipient[/blue] = [blue]$self[/blue]->[maroon]getSocket[/maroon] [red]([/red][blue]$to[/blue][red])[/red][red];[/red]
						[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$recipient[/blue],[red]"[/red][purple]21|[blue]$to[/blue]|[blue]$msg[/blue][/purple][red]"[/red][red])[/red][red];[/red]
					[red]}[/red]
				[red]}[/red]
			[red]}[/red]
			[olive][b]elsif[/b][/olive] [red]([/red][blue]$cmd[/blue] == [fuchsia]30[/fuchsia][red])[/red] [red]{[/red]
				[gray][i]# 30 = send public message.[/i][/gray]
				[olive][b]if[/b][/olive] [red]([/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]login[red]}[/red][red])[/red] [red]{[/red]
					[black][b]my[/b][/black] [blue]$msg[/blue] = [black][b]join[/b][/black] [red]([/red][red]"[/red][purple]|[/purple][red]"[/red],[blue]@args[/blue][red])[/red][red];[/red]
					[blue]$self[/blue]->[maroon]broadcast[/maroon] [red]([/red][red]"[/red][purple]31|[blue]$self[/blue]->{conn}->{[blue]$id[/blue]}->{username}|[blue]$msg[/blue][/purple][red]"[/red][red])[/red][red];[/red]
				[red]}[/red]
			[red]}[/red]
			[olive][b]elsif[/b][/olive] [red]([/red][blue]$cmd[/blue] == [fuchsia]40[/fuchsia][red])[/red] [red]{[/red]
				[gray][i]# 40 = client ready.[/i][/gray]
				[black][b]my[/b][/black] [blue]$proto[/blue] = [black][b]join[/b][/black] [red]([/red][red]"[/red][purple]|[/purple][red]"[/red],[blue]@args[/blue][red])[/red][red];[/red]
				[blue]$proto[/blue] = [fuchsia]0[/fuchsia] [olive][b]unless[/b][/olive] [black][b]length[/b][/black] [blue]$proto[/blue] > [fuchsia]0[/fuchsia][red];[/red]

				[gray][i]# Client is ready now.[/i][/gray]
				[blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]announce[red]}[/red] = [fuchsia]1[/fuchsia][red];[/red]
				[black][b]my[/b][/black] [blue]@welcome[/blue] = [url=http://perldoc.perl.org/functions/reverse.html][black][b]reverse[/b][/black][/url] [red]([/red][blue]@[/blue][red]{[/red][blue]$self[/blue]->[red]{[/red]welcome[red]}[/red][red]}[/red][red])[/red][red];[/red]
				[olive][b]foreach[/b][/olive] [black][b]my[/b][/black] [blue]$send[/blue] [red]([/red][blue]@welcome[/blue][red])[/red] [red]{[/red]
					[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$socket[/blue],[red]"[/red][purple]40|1[blue]$send[/blue][/purple][red]"[/red][red])[/red][red];[/red]
				[red]}[/red]
			[red]}[/red]
			[olive][b]elsif[/b][/olive] [red]([/red][blue]$cmd[/blue] == [fuchsia]50[/fuchsia][red])[/red] [red]{[/red]
				[gray][i]# 50 = Staff password.[/i][/gray]
				[black][b]my[/b][/black] [blue]$pass[/blue] = [black][b]join[/b][/black] [red]([/red][red]"[/red][purple]|[/purple][red]"[/red],[blue]@args[/blue][red])[/red][red];[/red]

				[olive][b]if[/b][/olive] [red]([/red][black][b]defined[/b][/black] [blue]$self[/blue]->[red]{[/red]password[red]}[/red] && [blue]$pass[/blue] eq [blue]$self[/blue]->[red]{[/red]password[red]}[/red][red])[/red] [red]{[/red]
					[gray][i]# This is a staff member.[/i][/gray]
					[black][b]print[/b][/black] [red]"[/red][purple]Make [blue]$id[/blue] a Staff Connection[purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
					[blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]level[red]}[/red] = [fuchsia]1[/fuchsia][red];[/red]
				[red]}[/red]
			[red]}[/red]
			[olive][b]elsif[/b][/olive] [red]([/red][blue]$cmd[/blue] == [fuchsia]60[/fuchsia][red])[/red] [red]{[/red]
				[gray][i]# 60 = Promote other users[/i][/gray]
				[black][b]my[/b][/black] [red]([/red][blue]$user[/blue],[blue]$newlevel[/blue][red])[/red] = [blue]@args[/blue][red];[/red]

				[gray][i]# Only admin users can use this option.[/i][/gray]
				[olive][b]if[/b][/olive] [red]([/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]level[red]}[/red] == [fuchsia]1[/fuchsia][red])[/red] [red]{[/red]
					[gray][i]# See that the user they mentioned exists.[/i][/gray]
					[black][b]my[/b][/black] [blue]$targetid[/blue] = -[fuchsia]1[/fuchsia][red];[/red]
					[black][b]my[/b][/black] [blue]$oldwho[/blue] = [red]'[/red][purple][/purple][red]'[/red][red];[/red]
					[olive][b]foreach[/b][/olive] [black][b]my[/b][/black] [blue]$con[/blue] [red]([/red][black][b]keys[/b][/black] [blue]%[/blue][red]{[/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red][red]}[/red][red])[/red] [red]{[/red]
						[olive][b]next[/b][/olive] [olive][b]unless[/b][/olive] [black][b]exists[/b][/black] [blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$con[/blue][red]}[/red]->[red]{[/red]nickname[red]}[/red][red];[/red]
						[olive][b]if[/b][/olive] [red]([/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$con[/blue][red]}[/red]->[red]{[/red]nickname[red]}[/red] eq [blue]$user[/blue][red])[/red] [red]{[/red]
							[blue]$oldwho[/blue] = [blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$con[/blue][red]}[/red]->[red]{[/red]username[red]}[/red][red];[/red]
							[blue]$targetid[/blue] = [blue]$con[/blue][red];[/red]
						[red]}[/red]
					[red]}[/red]

					[olive][b]if[/b][/olive] [red]([/red][blue]$targetid[/blue] >= [fuchsia]0[/fuchsia][red])[/red] [red]{[/red]
						[gray][i]# They do. Promote them.[/i][/gray]
						[black][b]my[/b][/black] [blue]$newwho[/blue] = [black][b]join[/b][/black] [red]([/red][red]"[/red][purple][/purple][red]"[/red],[blue]$newlevel[/blue],[blue]$user[/blue][red])[/red][red];[/red]
						[blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$targetid[/blue][red]}[/red]->[red]{[/red]level[red]}[/red] = [blue]$newlevel[/blue][red];[/red]
						[blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$targetid[/blue][red]}[/red]->[red]{[/red]username[red]}[/red] = [blue]$newwho[/blue][red];[/red]
						[blue]$self[/blue]->[red]{[/red]who[red]}[/red]->[red]{[/red][blue]$newwho[/blue][red]}[/red] = [black][b]delete[/b][/black] [blue]$self[/blue]->[red]{[/red]who[red]}[/red]->[red]{[/red][blue]$oldwho[/blue][red]}[/red][red];[/red]
						[black][b]print[/b][/black] [red]"[/red][purple]Promote [blue]$user[/blue] ([blue]$targetid[/blue]) to [blue]$newlevel[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
						[url=http://perldoc.perl.org/functions/use.html][black][b]use[/b][/black][/url] [green]Data::Dumper[/green][red];[/red]
						[black][b]print[/b][/black] [maroon]Dumper[/maroon][red]([/red][blue]$self[/blue][red])[/red][red];[/red]

						[gray][i]# Send the Who List.[/i][/gray]
						[blue]$self[/blue]->[maroon]sendWhoList[/maroon][red]([/red][red])[/red][red];[/red]
					[red]}[/red]
					[olive][b]else[/b][/olive] [red]{[/red]
						[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$socket[/blue],[red]"[/red][purple]21|3ChatClient|^1User not found.[/purple][red]"[/red][red])[/red][red];[/red]
					[red]}[/red]
				[red]}[/red]
				[olive][b]else[/b][/olive] [red]{[/red]
					[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$socket[/blue],[red]"[/red][purple]21|3ChatClient|^Permission denied.[/purple][red]"[/red][red])[/red][red];[/red]
				[red]}[/red]
			[red]}[/red]
			[olive][b]elsif[/b][/olive] [red]([/red][blue]$cmd[/blue] == [fuchsia]70[/fuchsia][red])[/red] [red]{[/red]
				[gray][i]# 70 = ignore user[/i][/gray]
				[black][b]my[/b][/black] [blue]$target[/blue] = [black][b]join[/b][/black] [red]([/red][red]"[/red][purple]|[/purple][red]"[/red],[blue]@args[/blue][red])[/red][red];[/red]
				[olive][b]if[/b][/olive] [red]([/red][black][b]length[/b][/black] [blue]$target[/blue] > [fuchsia]0[/fuchsia][red])[/red] [red]{[/red]
					[gray][i]# Send mutual ignore to this user's client.[/i][/gray]
					[black][b]my[/b][/black] [blue]$recipient[/blue] = [blue]$self[/blue]->[maroon]getSocket[/maroon] [red]([/red][blue]$target[/blue][red])[/red][red];[/red]
					[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$recipient[/blue],[red]"[/red][purple]70|[blue]$self[/blue]->{conn}->{[blue]$id[/blue]}->{username}[/purple][red]"[/red][red])[/red][red];[/red]
				[red]}[/red]
			[red]}[/red]
			[olive][b]else[/b][/olive] [red]{[/red]
				[gray][i]# Unknown command.[/i][/gray]
				[olive][b]if[/b][/olive] [red]([/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]login[red]}[/red][red])[/red] [red]{[/red]
					[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$socket[/blue],[red]"[/red][purple]21|3ChatClient|^1Command not implemented.[/purple][red]"[/red][red])[/red][red];[/red]
				[red]}[/red]
			[red]}[/red]
		[red]}[/red]
	[red]}[/red]
[red]}[/red]
[tt]------------------------------------------------------------
Core (perl 5.8.8) Modules used :
[ul]
[li]Data::Dumper - stringified perl data structures, suitable for both printing and eval[/li]
[/ul]
[/tt]

So, focusing on the reply() method:

I had put the $socket->send line inside of an eval statement, because if I didn't, it would die "can't determine peeraddr" when a socket was disconnected. I thought it should've did the "or do" when $sock->send failed, which is where it would disconnect the user, and send a disconnect message to the room if the user was signed in.

So the eval statement's "catch" code was set to do the same, disconnect the socket and delete it from the select object.

But, it doesn't work. When a user disconnects, I get the "can't determine peeraddr" warning a couple of times, then the CPU usage spikes to 100% for the process.

Anybody know a way to gracefully handle disconnects?

-------------
Cuvou.com | My personal homepage
Project Fearless | My web blog
 
Sort by date Sort by votes
ich, my post got cut off.

Code: 
			[olive][b]elsif[/b][/olive] [red]([/red][blue]$cmd[/blue] == [fuchsia]60[/fuchsia][red])[/red] [red]{[/red]
				[gray][i]# 60 = Promote other users[/i][/gray]
				[url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [red]([/red][blue]$user[/blue],[blue]$newlevel[/blue][red])[/red] = [blue]@args[/blue][red];[/red]

				[gray][i]# Only admin users can use this option.[/i][/gray]
				[olive][b]if[/b][/olive] [red]([/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]level[red]}[/red] == [fuchsia]1[/fuchsia][red])[/red] [red]{[/red]
					[gray][i]# See that the user they mentioned exists.[/i][/gray]
					[black][b]my[/b][/black] [blue]$targetid[/blue] = -[fuchsia]1[/fuchsia][red];[/red]
					[black][b]my[/b][/black] [blue]$oldwho[/blue] = [red]'[/red][purple][/purple][red]'[/red][red];[/red]
					[olive][b]foreach[/b][/olive] [black][b]my[/b][/black] [blue]$con[/blue] [red]([/red][url=http://perldoc.perl.org/functions/keys.html][black][b]keys[/b][/black][/url] [blue]%[/blue][red]{[/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red][red]}[/red][red])[/red] [red]{[/red]
						[olive][b]next[/b][/olive] [olive][b]unless[/b][/olive] [url=http://perldoc.perl.org/functions/exists.html][black][b]exists[/b][/black][/url] [blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$con[/blue][red]}[/red]->[red]{[/red]nickname[red]}[/red][red];[/red]
						[olive][b]if[/b][/olive] [red]([/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$con[/blue][red]}[/red]->[red]{[/red]nickname[red]}[/red] eq [blue]$user[/blue][red])[/red] [red]{[/red]
							[blue]$oldwho[/blue] = [blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$con[/blue][red]}[/red]->[red]{[/red]username[red]}[/red][red];[/red]
							[blue]$targetid[/blue] = [blue]$con[/blue][red];[/red]
						[red]}[/red]
					[red]}[/red]

					[olive][b]if[/b][/olive] [red]([/red][blue]$targetid[/blue] >= [fuchsia]0[/fuchsia][red])[/red] [red]{[/red]
						[gray][i]# They do. Promote them.[/i][/gray]
						[black][b]my[/b][/black] [blue]$newwho[/blue] = [url=http://perldoc.perl.org/functions/join.html][black][b]join[/b][/black][/url] [red]([/red][red]"[/red][purple][/purple][red]"[/red],[blue]$newlevel[/blue],[blue]$user[/blue][red])[/red][red];[/red]
						[blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$targetid[/blue][red]}[/red]->[red]{[/red]level[red]}[/red] = [blue]$newlevel[/blue][red];[/red]
						[blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$targetid[/blue][red]}[/red]->[red]{[/red]username[red]}[/red] = [blue]$newwho[/blue][red];[/red]
						[blue]$self[/blue]->[red]{[/red]who[red]}[/red]->[red]{[/red][blue]$newwho[/blue][red]}[/red] = [url=http://perldoc.perl.org/functions/delete.html][black][b]delete[/b][/black][/url] [blue]$self[/blue]->[red]{[/red]who[red]}[/red]->[red]{[/red][blue]$oldwho[/blue][red]}[/red][red];[/red]
						[url=http://perldoc.perl.org/functions/print.html][black][b]print[/b][/black][/url] [red]"[/red][purple]Promote [blue]$user[/blue] ([blue]$targetid[/blue]) to [blue]$newlevel[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
						[url=http://perldoc.perl.org/functions/use.html][black][b]use[/b][/black][/url] [green]Data::Dumper[/green][red];[/red]
						[black][b]print[/b][/black] [maroon]Dumper[/maroon][red]([/red][blue]$self[/blue][red])[/red][red];[/red]

						[gray][i]# Send the Who List.[/i][/gray]
						[blue]$self[/blue]->[maroon]sendWhoList[/maroon][red]([/red][red])[/red][red];[/red]
					[red]}[/red]
					[olive][b]else[/b][/olive] [red]{[/red]
						[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$socket[/blue],[red]"[/red][purple]21|3ChatClient|^1User not found.[/purple][red]"[/red][red])[/red][red];[/red]
					[red]}[/red]
				[red]}[/red]
				[olive][b]else[/b][/olive] [red]{[/red]
					[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$socket[/blue],[red]"[/red][purple]21|3ChatClient|^Permission denied.[/purple][red]"[/red][red])[/red][red];[/red]
				[red]}[/red]
			[red]}[/red]
			[olive][b]elsif[/b][/olive] [red]([/red][blue]$cmd[/blue] == [fuchsia]70[/fuchsia][red])[/red] [red]{[/red]
				[gray][i]# 70 = ignore user[/i][/gray]
				[black][b]my[/b][/black] [blue]$target[/blue] = [black][b]join[/b][/black] [red]([/red][red]"[/red][purple]|[/purple][red]"[/red],[blue]@args[/blue][red])[/red][red];[/red]
				[olive][b]if[/b][/olive] [red]([/red][url=http://perldoc.perl.org/functions/length.html][black][b]length[/b][/black][/url] [blue]$target[/blue] > [fuchsia]0[/fuchsia][red])[/red] [red]{[/red]
					[gray][i]# Send mutual ignore to this user's client.[/i][/gray]
					[black][b]my[/b][/black] [blue]$recipient[/blue] = [blue]$self[/blue]->[maroon]getSocket[/maroon] [red]([/red][blue]$target[/blue][red])[/red][red];[/red]
					[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$recipient[/blue],[red]"[/red][purple]70|[blue]$self[/blue]->{conn}->{[blue]$id[/blue]}->{username}[/purple][red]"[/red][red])[/red][red];[/red]
				[red]}[/red]
			[red]}[/red]
			[olive][b]else[/b][/olive] [red]{[/red]
				[gray][i]# Unknown command.[/i][/gray]
				[olive][b]if[/b][/olive] [red]([/red][blue]$self[/blue]->[red]{[/red]conn[red]}[/red]->[red]{[/red][blue]$id[/blue][red]}[/red]->[red]{[/red]login[red]}[/red][red])[/red] [red]{[/red]
					[blue]$self[/blue]->[maroon]reply[/maroon] [red]([/red][blue]$socket[/blue],[red]"[/red][purple]21|3ChatClient|^1Command not implemented.[/purple][red]"[/red][red])[/red][red];[/red]
				[red]}[/red]
			[red]}[/red]
		[red]}[/red]
	[red]}[/red]
[red]}[/red]
[tt]------------------------------------------------------------
Core (perl 5.8.8) Modules used :
[ul]
[li]Data::Dumper - stringified perl data structures, suitable for both printing and eval[/li]
[/ul]
[/tt]

So anyway, in the reply() method, here was the problem:

$socket->send ("$msg\x0d\x0a") or do {

This would die "can't determine peeraddr" if I tried to call this method on a socket that didn't exist. For some reason the "or do" part wasn't being used in this case, so I wrapped the entire block of code into an eval statement.

So, when a socket disconnects, it warns instead of dies about the peeraddr, but the process begins taking up 100% CPU.

Anybody know how to make it *not* take up so much memory? Any way to better handle disconnects?

Thanks in advance.

-------------
Cuvou.com | My personal homepage
Project Fearless | My web blog
 
Upvote 0 Downvote
Alright, nevermind, I figured it out on my own. :)

Apparently, when a client disconnects you'll get a blank packet from them immediately... so basically:

Code: 
            # Get their ID.
            my $id = $socket->fileno;

            # Read their request.
            my $line = '';
            $socket->recv ($line, 2048);

            [COLOR=blue]# Before chomping or anything, see if its blank
            if ($line eq "") {
               # disconnect them here... and then:
               next;
            }[/color]

            chomp $line;
            $line =~ s/\r//ig;
            $line =~ s/\n//ig;

-------------
Cuvou.com | My personal homepage
Project Fearless | My web blog
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Dino_1000
  • Locked
  • Question
Use the perl debugger to dump all the data in a string variable
Replies
0
Views
159
Dino_1000
Dino_1000
dan
  • Locked
  • Question
add a variable to subject in formmail.pl
Replies
6
Views
217
feherke
feherke
Limbomusic
  • Locked
  • Question
Perl files getting accessed directly
Replies
0
Views
177
Limbomusic
Limbomusic
newbie1238585
  • Locked
  • Question
Perl how to read string in csv file * as wildcard operator
Replies
2
Views
207
mikrom
mikrom
ss_ham
  • Locked
  • Question
in Perl find call looking to exclude folder and ignore duplicate finds.
Replies
2
Views
201
ss_ham
ss_ham

Part and Inventory Search

Sponsor

Back
Top