Re: patch: FvwmSocket module

[Mikhael Goikhman]

On 13 Jan 2010 13:48:03 -0600, Rich Coe wrote:
> 
> This is a module I wrote which allows writing a module in another
> language (java) that does not support direct access to file
> descriptors (java) like 'c'.  If you add this module to your fvwm
> config file it listens for connections on a internal localhost
> socket (default 127.0.0.1:10010). If there are any connections, the
> module broadcasts all fvwm module messages to the socket.  Any fvwm
> module command messages received on a particular socket file
> descriptor are routed to fvwm and the response is sent back to the
> originating socket.

I'd like to comment on the code without expressing any opinion
whether such module is needed, and in which form (we have at least
FvwmCommand that tries to do the same, just using UNIX sockets).

This code is large (over 1000 lines) and full of internal details
duplicated from other modules. It is hard to maintain and enhance
such code.

I got a free time and reimplemented this module in Perl (attached).
It is significantly shorter, pretty easy to enhance, and it does not
really require maintenance, i.e. will continue to work even if
fvwm<->module protocol (and its perllib implementation) evolves.

I only tested it with multiple "telnet localhost 10010" instances,
but I see no reason why it should not work with any other clients.
It listens to all fvwm events, but I think it may have the same sane
defaults for mask/xmask that FvwmDebug module has, i.e. to ignore
noisy events like ENTER_WINDOW, FOCUS_CHANGE by default.

As a bonus, this attached FvwmSocket optionally works on fifos too
(a-la FvwmCommand) in addition to ports. Full debug info is available
with --debug 2 (or 3). An alternative to closing a client connection
is sending "bye" command from it. I think most of the error
situations (port used, various connections closed) are handled well.

fvwm modules in perl do not need compilation, just chmod a+x and
"Module /full/path/FvwmSocket", "KillModule /full/path/FvwmSocket".

Regards,
Mikhael.

#!/usr/bin/perl

use warnings;
use strict;

use lib `fvwm-perllib dir`;
use FVWM::Module;

use IO::Select;
use IO::Socket;

my $port = 10010;
my $fifo_filename = undef;
my $debug = 1;

sub show_usage {
        die "Usage: $0 [--help] [--port N] [--filename FIFO] [--debug LEVEL]\n";
}

# better borrow the default mask logic from FvwmDebug to skip noicy events
my $module = new FVWM::Module(
        Name => 'FvwmSocket',
        EnableOptions => {
                'h|help' => \&show_usage,
                'p|port' => \$port,
                'f|filename=s' => \$fifo_filename,
                'd|debug=i' => \$debug,
        },
        Debug => \$debug,
) || show_usage();

my $fvwm_socket = $module->{istream};
my $main_socket = $fifo_filename
        ? IO::Socket::UNIX->new(Listen => 1, Local => $fifo_filename)
        : IO::Socket::INET->new(Listen => 1, LocalPort => $port, Reuse => 1);

my $listen_string = $fifo_filename ? "fifo $fifo_filename" : "port $port";
unless ($main_socket) {
        $module->show_error("Can't open $listen_string: $!");
        exit;
}

my $socket_pool = new IO::Select($fvwm_socket, $main_socket);
my @client_sockets;

sub broadcast_event ($$) {
        my $module = shift;
        my $event = shift;
        foreach my $socket (@client_sockets) {
                $socket->print($event->dump . "\n");
        }
}

$module->debug("started to listen on $listen_string");
$module->add_handler(MAX_MSG_MASK, \&broadcast_event);
$module->add_handler(MAX_XMSG_MASK | M_EXTENDED_MSG, \&broadcast_event);

while (my @ready_sockets = $socket_pool->can_read) {
        foreach my $socket (@ready_sockets) {
                if ($socket == $main_socket) {
                        my $new_socket = $main_socket->accept || next;
                        $module->debug("new client accepted $new_socket");
                        push @client_sockets, $new_socket;
                        $socket_pool->add($new_socket);
                }
                elsif ($socket == $fvwm_socket) {
                        unless ($module->process_packet($module->read_packet)) {
                                foreach my $socket ($main_socket, 
@client_sockets) {
                                        $socket->close if $socket;
                                }
                                $module->debug("terminated");
                                exit;
                        }
                }
                else {
                        my $line = $socket->getline;
                        my $should_close = 1;
                        if (defined $line && $line !~ /^bye\s/i) {
                                $line =~ s/\r?\n$//;
                                $module->send($line) unless $line =~ 
/^\s*(#.*?)$/;
                                $should_close = 0;
                        }
                        if ($should_close) {
                                $module->debug("dropping client $socket");
                                $socket_pool->remove($socket);
                                @client_sockets = grep { $_ != $socket } 
@client_sockets;
                                $socket->close;
                        }
                }
        }
}