[Techtalk] trying to get xmon to work...

[Almut Behrens]

On Fri, Nov 05, 2004 at 08:26:09AM +0100, Almut Behrens wrote:
> On Fri, Nov 05, 2004 at 01:34:23AM +0100, Riccarda Cassini wrote:
> > On Linux, the extension is obviously called "MIT-SCREEN-SAVER" (that's
> > also what xdpyinfo lists).  So, everything is fine, if that name is
> > requested.  OTOH, when AIX asks for "SCREEN-SAVER", Linux just responds
> > with "sorry, haven't got that"...
> > I guess, I'd have to patch either the AIX X libraries (at least in
> > theory), or the X server code on the Linux side, to make them agree on
> > the name.
> 
> Well, you could write yet another port forwarder that essentially does
> s/SCREEN-SAVER/MIT-SCREEN-SAVER/ if there's a QueryExtension request,
> passing on everything else unmodified.

...okay, had some spare time, so I just wrote it for you :)

Sorry for spamming the list, but I thought it might also be of use
to someone else sometime, 'cos if you remove the part which edits the
QueryExtension X request, you'd be left with a general purpose port
forwarder for X/HTTP/whatever, which makes it rather easy to capture or
edit any stream sent across the wire...

By default, the proxy listens on :2 and connects to :1, but you can
change that by passing display numbers as options, e.g. "-l 1 -c 0",
or "--listen 1 --connect 0", if you like it verbose.

I haven't tested it exhaustively, though -- just wrote a trivial test
program calling XScreenSaverQueryInfo(), and there were no longer any
errors with the AIX -> Linux setup...

Enjoy!
Almut


#!/usr/bin/perl -w

use IO::Socket;
use IO::Select;                                                                      
use POSIX ":sys_wait_h";
use Getopt::Long;

my $listen_display  = 2;  # defaults
my $connect_display = 1;
GetOptions( 'listen=i'  => \$listen_display,
            'connect=i' => \$connect_display );

xproxy($listen_display, $connect_display);


sub listening_socket {
    my $port = shift;
    my $sock = IO::Socket::INET->new(
        Proto     => 'tcp',
        LocalAddr => "0.0.0.0:$port",  # bind ANY
        Listen    => SOMAXCONN,
        ReuseAddr => 1,
    )
      or die "$0: can't create listening socket: $!\n";
    return $sock;
}

sub connect_X_server {
    my $port = shift;
    my $sock = IO::Socket::INET->new(
        Proto     => 'tcp',
        PeerAddr  => "localhost:$port",
    )
      or die "$0: can't connect to X server: $!\n";
    return $sock;
}

sub xproxy {
    my $listen_port  = 6000 + shift;   # :0 always is port 6000
    my $connect_port = 6000 + shift;

    $SIG{CHLD} = \&reaper;
    
    my $sock = listening_socket($listen_port);

    while (my $client = $sock->accept()) {

        my $kidpid = fork();  die "cannot fork" unless defined $kidpid;
        if ($kidpid) {
            close $client;
            next;
        } 
        close $sock;

        my $server = connect_X_server($connect_port);

        $kidpid = fork();  die "cannot fork" unless defined $kidpid;
        if ($kidpid) {
            shovel($client, $server, \&edit_QueryExt);  # forward requests
            kill 'TERM', $kidpid;
        } else {
            shovel($server, $client);                   # forward replies
            kill 'TERM', getppid();
        } 
        exit;
    } 
}

sub shovel {
    my ($sock_from, $sock_to, $editproc) = @_;
    my $slct = IO::Select->new($sock_from);
    my $buf;
    
    while($slct->can_read()) {  # blocks until socket is ready for reading
        sysread $sock_from, $buf, 1000000  or last;

        $editproc->(\$buf) if ref($editproc) eq 'CODE';

        syswrite $sock_to, $buf, length($buf);
    }
}

sub edit_QueryExt {
    my $buf = shift;  # ref
    my $opcode = unpack "C", $$buf;
    if ($opcode == 98) {   # = QueryExtension
        my $targetname = 'MIT-SCREEN-SAVER';
        # the following method is a bit crude, but
        # it should suffice for the purpose at hand
        if ($$buf =~ s/SCREEN-SAVER/$targetname/) {
            # okay, this is the ugly part, 'cos if we've modified the
            # request, we have to adjust some length-fields...
            substr($$buf,4,2) = pack "n", length($targetname);
            substr($$buf,2,2) = pack "n", int(length($targetname)/4)+2;
        }
    } # else pass through unmodified
}

sub reaper { # cleanup subprocesses
    while (waitpid(-1,WNOHANG) > 0) {}
    $SIG{CHLD} = \&reaper; 
}