diff options
Diffstat (limited to 'ksirc/puke/puke.pl')
| -rw-r--r-- | ksirc/puke/puke.pl | 225 |
1 files changed, 225 insertions, 0 deletions
diff --git a/ksirc/puke/puke.pl b/ksirc/puke/puke.pl new file mode 100644 index 00000000..f0d2c7fd --- /dev/null +++ b/ksirc/puke/puke.pl @@ -0,0 +1,225 @@ +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"; + |