[opendemo-cvs] CVS: opendemo/tools/odcut odcutgui.pm,1.45,1.46

[Uwe G. <gi...@us...>]

Update of /cvsroot/opendemo/opendemo/tools/odcut
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31365

Modified Files:
	odcutgui.pm 
Log Message:
make it work (more or less) with rcon.
rcon needs a running map. So we start the correct one. But later we start
what we really need.


Index: odcutgui.pm
===================================================================
RCS file: /cvsroot/opendemo/opendemo/tools/odcut/odcutgui.pm,v
retrieving revision 1.45
retrieving revision 1.46
diff -C2 -d -r1.45 -r1.46
*** odcutgui.pm	27 Oct 2004 17:19:27 -0000	1.45
--- odcutgui.pm	27 Oct 2004 19:54:13 -0000	1.46
***************
*** 25,28 ****
--- 25,29 ----
  use Cwd;
  use FileHandle;
+ use Sys::Hostname;
  
  @ISA = qw(Wx::Frame);
***************
*** 225,228 ****
--- 226,231 ----
  	# EVT_END_PROCESS( $self, -1, \&OnEndProcess );
  
+ 	$self->{"od_rcon"} = od_rcon->new();
+ 
  	$self;
  }
***************
*** 629,635 ****
  
  	# Start anew.
- #	my $command = sprintf "%s +set fs_game %s +set od_mode \"play\" +set od_zlib 0 +set od_pipe 1",
- #		$self->{"game_executable"},
- #		$self->{"game_opendemo"};
  	my @command = [
  #			Cwd::getcwd() . "/../pwrap.pl",
--- 632,635 ----
***************
*** 637,641 ****
  			$self->{"game_executable"},
  			"+set", "fs_game", $self->{"game_opendemo"},
! 			"+set", "rconPassword", $self->{"game_password"}
  			];
  
--- 637,644 ----
  			$self->{"game_executable"},
  			"+set", "fs_game", $self->{"game_opendemo"},
! 			"+set", "rconPassword", $self->{"game_password"},
! 			"+sv_pure", "0",
! 			# What a hack! We need to start this map to activate rcon.
! 			"+map", $self->{"output"}->get_currentfile()->mapname()
  			];
  
***************
*** 668,671 ****
--- 671,696 ----
  
  
+ sub SendGame($$)
+ {
+ 	my ($self, $request) = @_;
+ 
+ 	my $reply = $self->{"od_rcon"}->request(hostname(), 27960, 10.0, $request);
+ 
+ 	return $reply;
+ }
+ 
+ 
+ sub RconGame($$)
+ {
+ 	my ($self, $command) = @_;
+ 
+ 	# The 'odcut' here will appear on the game console to mark the command.
+ 	my $request = "rcon\r" . $self->{"game_password"} . "\rodcut " . $command . "\0";
+ 	my $reply = $self->SendGame($request);
+ 
+ 	return $reply;
+ }
+ 
+ 
  sub OnProcessEnd($)
  {
***************
*** 714,718 ****
  		$self->OnGameStart();
  	}
- 	my $stream = $self->{"odgame"}->GetOutputStream();
  
  	# this requires, that the demo file pipe is in od.
--- 739,742 ----
***************
*** 720,728 ****
  	my $map = $output->get_currentfile()->mapname();
  
! 	printf $stream ("set od_mode \"play\"\n");
! 	printf $stream ("set od_zlib 0\n");
! 	printf $stream ("set od_pipe 1\n");
! 	printf $stream ("set od_demofile %s\n", $demofile);
! 	printf $stream ("map %s\n", $map);
  }
  
--- 744,752 ----
  	my $map = $output->get_currentfile()->mapname();
  
! 	$self->RconGame(sprintf ("set od_mode \"play\""));
! 	$self->RconGame(sprintf ("set od_zlib 0"));
! 	$self->RconGame(sprintf ("set od_pipe 1"));
! 	$self->RconGame(sprintf ("set od_demofile %s", $demofile));
! 	$self->RconGame(sprintf ("map %s", $map));
  }
  
***************
*** 970,973 ****
--- 994,1105 ----
  
  
+ package od_rcon;
+ 
+ use strict;
+ use Socket;
+ use Sys::Hostname;
+ 
+ sub new($)
+ {
+ 	my $class = shift;
+ 	my $self = {};
+ 	bless($self,$class);
+ 
+ 	my $proto = getprotobyname('udp');
+ 	my $socket;
+ 	if (!socket($socket, PF_INET, SOCK_DGRAM, $proto)) {
+ 		fprintf STDERR "socket() failed: $!\n";
+ 		return undef;
+ 	}
+ 	my $iaddr = gethostbyname(hostname());
+ 	my $paddr = sockaddr_in(0, $iaddr);
+ 	if (!bind($socket, $paddr)) {
+ 		fprintf STDERR "bind() failed: $!\n";
+ 		return undef;
+ 	}
+ 	$self->{"socket"} = $socket;
+ 
+ 	return $self;
+ }
+ 
+ 
+ sub DESTROY
+ {
+ 	my $self = shift;
+ 
+ 	if (defined $self->{"socket"}) {
+ 		$self->{"socket"}->close();
+ 		delete $self->{"socket"};
+ 	}
+ }
+ 
+ 
+ sub request($$$$$)
+ {
+ 	my ($self, $host, $port, $timeout, $request) = @_;
+ 
+ 	printf STDERR "send to %s:%d, wait %f sec\n", $host, $port, $timeout;
+ 	printf STDERR "request is '%s'\n", quotemeta($request);
+ 
+ 	my $hisiaddr = gethostbyname($host);
+ 	my $hispaddr = sockaddr_in($port, $hisiaddr);
+ 	# The odcut here is simply the name, who did it.
+ 	my $packet = "\377\377\377\377" . $request;
+ 	my $rin = "";
+ 	vec($rin, fileno($self->{"socket"}), 1) = 1;
+ 	my $sendtimeout = 1.0;
+ 	while ($timeout>0) {
+ 		if (!send($self->{"socket"}, $packet, 0, $hispaddr)) {
+ 			printf STDERR "send() failed: $!\n";
+ 			printf STDERR "host=$host hisiaddr=$hisiaddr port=$port\n";
+ 			printf STDERR "hispaddr=$hispaddr\n";
+ 			printf STDERR "socket=%s\n", $self->{"socket"};
+ 			return undef;
+ 		}
+ 		printf STDERR ">";
+ 
+ 		(my $nfound, my $sendtimeout_left) =
+ 		select (my $rout = $rin, undef, undef, $sendtimeout);
+ 		# We subtract the actual wait time for this selecto() from the global wait time.
+ 		$timeout -= ($sendtimeout - $sendtimeout_left);
+ 		if ($nfound<0) {
+ 			printf STDERR "select() failed: $!\n";
+ 			return undef;
+ 		}
+ 		if ($nfound == 0) {
+ 			next;
+ 		}
+ 		if ($rout eq $rin) {
+ 			my $hispaddr_r = recv($self->{"socket"}, my $reply, 65536, 0);
+ 			if (!$hispaddr_r) {
+ 				printf STDERR "recv() failed: $!\n";
+ 				return undef;
+ 			}
+ 			printf STDERR "<";
+ 			my ($port_r, $hisiaddr_r) = sockaddr_in($hispaddr_r);
+ 			if ($hisiaddr ne $hisiaddr_r) {
+ 				printf STDERR "got reply from $hisiaddr_r, expected $hisiaddr, ignore.\n";
+ 				next;
+ 			}
+ 			if ($port != $port_r) {
+ 				printf STDERR "got reply from port $port_r, expected $port, exignore.\n";
+ 				next;
+ 			}
+ 			if (length($reply)>=4) {
+ 				if (substr($reply,0,4) eq '\377\377\377\377') {
+ 					$reply = substr($reply,4);
+ 				}
+ 			}
+ 			printf STDERR "reply was '%s'\n", quotemeta($reply);
+ 			return $reply;
+ 		}
+ 	}
+ 	return undef;
+ }
+ 
+ 
+ ######################################################################
+ 
+ 
  package odprocess;