You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
226 lines
6.5 KiB
226 lines
6.5 KiB
use Socket;
|
|
use Fcntl;
|
|
|
|
#
|
|
# Clean up if this is the second load.
|
|
#
|
|
# Don't close anything so we can be loaded twice.
|
|
#
|
|
#if($PUKEFd != undef){
|
|
# &remsel($PUKEFd);
|
|
# close($PUKEFd);
|
|
# sleep(1);
|
|
# $PUKEFd = undef;
|
|
#}
|
|
|
|
#
|
|
# Puke timeout waiting for messages
|
|
$PUKE_TIMEOUT = 10;
|
|
|
|
#
|
|
# Setup flag fo syncronous operation
|
|
# 1 for sync
|
|
# 0 for async/fly by the seat of your pants
|
|
#
|
|
$SYNC = 0;
|
|
|
|
#
|
|
# Setup debugging logger, comment out for production use
|
|
#
|
|
$DEBUG = 0;
|
|
if($DEBUG){
|
|
open(LOG, ">msg-log") || warn "Failed to open log file: $!\n";
|
|
select(LOG); $| = 1; select(STDOUT);
|
|
print LOG "Start time: ". `date`;
|
|
}
|
|
|
|
|
|
|
|
#
|
|
# Multi operation level handler, winId Based.
|
|
#
|
|
# PUKE_HANDLER{Cmd}{winId} = sub();
|
|
|
|
%PUKE_HANDLER = ();
|
|
|
|
#
|
|
# Default handler is called if no handler defined
|
|
# Default handlers defined in commands-handler.pl
|
|
# Single level PUKE_DEF_HANDLER{$cmd};
|
|
#
|
|
|
|
#%PUKE_DEF_HANDLER = ();
|
|
|
|
#require 'commands-perl.pl';
|
|
&docommand("/load commands-perl.pl");
|
|
#require 'commands-handler.pl';
|
|
&docommand("/load commands-handler.pl");
|
|
|
|
$PukeHeader = 42; # Alternating 1010 for 32 bits
|
|
$PukePacking = "Iiiiia*"; # 4 ints, followed by any number of of characters
|
|
$PukeMSize = length(pack($PukePacking, $PukeHeader, 0, 0, 0, 0, ""));
|
|
|
|
if(!$ENV{'PUKE_SOCKET'}) {
|
|
$sock = $ENV{'HOME'} . "/.ksirc.socket";
|
|
}
|
|
else {
|
|
$sock = $ENV{'PUKE_SOCKET'};
|
|
}
|
|
|
|
if($PUKEFd == undef){
|
|
$PUKEFd = &newfh;
|
|
$proto = getprotobyname('tcp');
|
|
socket($PUKEFd, PF_UNIX, SOCK_STREAM, 0) || print "PUKE: Sock failed: $!\n";
|
|
$sun = sockaddr_un($sock);
|
|
print "*P* PUKE: Connecting to $sock\n";
|
|
connect($PUKEFd,$sun) || (die "Puke: Connect failed: $!\n",$PUKEFailed=1);
|
|
select($PUKEFd); $| = 1; select(STDOUT);
|
|
#fcntl($PUKEFd, F_SETFL, O_NONBLOCK);
|
|
}
|
|
|
|
# Arg1: Command
|
|
# Arg2: WinId
|
|
# Arg3: iArg
|
|
# Arg4: cArg
|
|
sub PukeSendMessage {
|
|
my($cmd, $winid, $iarg, $carg, $handler, $waitfor) = @_;
|
|
# print("PUKE: cArg message too long $cArg\n") if(length($carg) > 50);
|
|
$PUKE_HANDLER{$cmd}{$winid} = $handler if $handler != undef;
|
|
my $msg = pack($PukePacking, $PukeHeader, $cmd, $winid, $iarg, length($carg), $carg);
|
|
syswrite($PUKEFd, $msg, length($msg));
|
|
# print STDERR "*** " . $msg . "\n";
|
|
print LOG kgettimeofday() . " SEND message: CMD: $PUKE_NUM2NAME{$cmd} WIN: $winid IARG: $iarg LEN: " . length($carg) . " CARG: $carg\n" if $DEBUG;
|
|
if($SYNC == 1 || $waitfor == 1){
|
|
return &sel_PukeRecvMessage(1, $winid, -$cmd, $carg);
|
|
}
|
|
return ();
|
|
}
|
|
|
|
sub sel_PukeRecvMessage {
|
|
($wait, $wait_winid, $wait_cmd, $wait_carg) = @_;
|
|
my($m);
|
|
my($cmd, $winid, $iarg, $carg, $junk);
|
|
|
|
while(1){
|
|
my $old_a = $SIG{'alarm'};
|
|
$SIG{'alarm'} = sub { die "alarm\n"; };
|
|
my $old_time = alarm($PUKE_TIMEOUT);
|
|
eval {
|
|
$len = sysread($PUKEFd, $m, $PukeMSize);
|
|
};
|
|
if($@){
|
|
print "*E* Timeout waiting for data for first sysread\n";
|
|
$SIG{ALRM} = $old_a;
|
|
alarm($old_time);
|
|
return;
|
|
}
|
|
$SIG{ALRM} = $old_a;
|
|
alarm($old_time);
|
|
|
|
if($len== 0){
|
|
&remsel($PUKEFd);
|
|
close($PUKEFd);
|
|
return;
|
|
}
|
|
# print "Length: $len " . length($m) . "\n";
|
|
($header, $cmd, $winid, $iarg, $length, $carg) = unpack($PukePacking, $m);
|
|
if($header != $PukeHeader){
|
|
print("*E* Invalid message received! Discarding! Got: $header wanted: $PukeHeader\n");
|
|
# return;
|
|
}
|
|
if($length > 0){
|
|
my $old_a = $SIG{'alarm'};
|
|
$SIG{'alarm'} = sub { die "alarm\n"; };
|
|
my $old_time = alarm($PUKE_TIMEOUT);
|
|
eval {
|
|
$clen = sysread($PUKEFd, $m2, $length);
|
|
};
|
|
if($@){
|
|
print "*E* Timeout waiting for cArg data\n";
|
|
}
|
|
$SIG{ALRM} = $old_a;
|
|
alarm($old_time);
|
|
|
|
if($length != $clen){
|
|
print "\n*E* Warning: wanted to read: $length got $clen\n";
|
|
}
|
|
$m .= $m2;
|
|
($header, $cmd, $winid, $iarg, $length, $carg) = unpack($PukePacking, $m);
|
|
}
|
|
# print("PUKE: Got => $PUKE_NUM2NAME{$cmd}/$cmd\n");
|
|
# print("PUKE: Got: $cmd, $winid, $iarg, $length, $carg\n");
|
|
# print("\n");
|
|
if($winid == undef){ $winid = 0; }
|
|
$blah = $carg;
|
|
$blah =~ s/\000//g;
|
|
print LOG kgettimeofday() . " GOT message: CMD: $PUKE_NUM2NAME{$cmd} WIN: $winid IARG: $iarg LEN: $length CARG: $blah\n" if $DEBUG;
|
|
#
|
|
# Check both $cmd and the correct reply -$cmd
|
|
#
|
|
my(%ARG) = ('iCommand' => $cmd,
|
|
'iWinId' => $winid,
|
|
'iArg' => $iarg,
|
|
'cArg' => $carg);
|
|
|
|
# print "*I* Def handler: $PUKE_DEF_HANDLER{$cmd}\n";
|
|
|
|
if($wait == 1 && $winid == $wait_winid && $wait_cmd == $cmd){
|
|
print LOG kgettimeofday() . " WAIT message: CMD: $PUKE_NUM2NAME{$cmd} WIN: $winid IARG: $iarg LEN: $length CARG: $blah\n" if $DEBUG;
|
|
($wait, $wait_winid, $wait_cmd, $wait_carg) = ();
|
|
return %ARG;
|
|
}
|
|
|
|
if($PUKE_HANDLER{-$cmd}{$winid}){ # one shot/command handler
|
|
&{$PUKE_HANDLER{-$cmd}{$winid}}(\%ARG);
|
|
} elsif ($PUKE_HANDLER{$cmd}{$winid}){
|
|
&{$PUKE_HANDLER{$cmd}{$winid}}(\%ARG);
|
|
} elsif ($PUKE_W_HANDLER{$cmd}{$winid}) { # widget specific handler
|
|
&{$PUKE_W_HANDLER{$cmd}{$winid}}(\%ARG);
|
|
} elsif ($PUKE_DEF_HANDLER{"$cmd"}) {# catch all
|
|
&{$PUKE_DEF_HANDLER{"$cmd"}}(\%ARG);
|
|
}
|
|
else {
|
|
#
|
|
# If there was no handler this is a widget creation falling throuhg
|
|
#
|
|
|
|
if($wait == 1 && (substr($wait_carg,0,7) eq substr($carg,0,7))){
|
|
print LOG kgettimeofday() . " WAI2 message: CMD: $PUKE_NUM2NAME{$cmd} WIN: $winid IARG: $iarg LEN: $length CARG: $blah\n" if $DEBUG;
|
|
($wait, $wait_winid, $wait_cmd, $wait_carg) = ();
|
|
return %ARG;
|
|
}
|
|
# No handler at all, unkown reply
|
|
print("*E* PUKE: Got unkown command: $cmd/$PUKE_NUM2NAME{$cmd}\n");
|
|
# print("PUKE: Got: $cmd, $winid, $iarg, $carg\n");
|
|
}
|
|
|
|
#
|
|
# If we're not waiting for a message, return
|
|
#
|
|
if(!$wait){
|
|
($wait, $wait_winid, $wait_cmd, $wait_carg) = ();
|
|
return ();
|
|
}
|
|
|
|
my($rin, $rout) =('', '');
|
|
vec($rin,fileno($PUKEFd),1) = 1;
|
|
$nfound = select($rout=$rin, undef, undef, 1);
|
|
if($nfound < 1){
|
|
print "*E* PUKE: Timed out waiting for reply, returning null\n";
|
|
print LOG kgettimeofday() . " FAIL message: CMD: $PUKE_NUM2NAME{$wait_cmd} WIN: $wait_winid IARG: ### LEN: $length CARG: $wait_carg\n" if $DEBUG;
|
|
return ();
|
|
}
|
|
}
|
|
}
|
|
|
|
&addsel($PUKEFd, "PukeRecvMessage", 0);
|
|
|
|
# Basics are up and running, now init Puke/Ksirc Interface.
|
|
|
|
my(%ARG) = &PukeSendMessage($PUKE_SETUP, $::PUKE_CONTROLLER, 0, $server, undef, 1);
|
|
|
|
$PukeMSize = $ARG{'iArg'};
|
|
print "*P* Puke: Initial Setup complete\n";
|
|
print "*P* Puke: Communications operational\n";
|
|
|