conmux/conmux-registry

   1 #!/usr/bin/perl
   2 #
   3 # conmux-registry -- console name registry server
   4 #
   5 # Main registry server.  This server holds host/port assignments for
   6 # conmux daemons registering with it.  This allows users to specify
   7 # human names for their consoles and find the relevant conmux daemon.
   8 #
   9 # (C) Copyright IBM Corp. 2004, 2005, 2006
  10 # Author: Andy Whitcroft <andyw@uk.ibm.com>
  11 #
  12 # The Console Multiplexor is released under the GNU Public License V2
  13 #
  14 use strict;
  15
  16 use FindBin;
  17 use Symbol qw(gensym);
  18
  19 use IO::Socket;
  20 use IO::Multiplex;
  21 use URI::Escape;
  22
  23 # Find our internal libraries.
  24 use lib $FindBin::Bin;
  25 use lib "$FindBin::Bin/../lib/";
  26 use lib "$FindBin::Bin/lib/";
  27 use Conmux;
  28
  29 our $P = 'conmux-registry';
  30 our $debug = 0;
  31
  32 #
  33 # LISTENER SOCKET: creates an intenet listener for new clients and
  34 # connects them to the junction provided.
  35 #
  36 package ListenerSocket;
  37
  38 sub new {
  39         my ($class, $mux, $port, $registry) = @_;
  40         my $self = bless { 'mux' => $mux, 'registry' => $registry }, $class;
  41
  42         print "ListenerSocket::new [$self] mux<$mux> port<$port> " .
  43                 "registry<$registry>\n" if ($main::debug);
  44
  45         $self->initialise($mux, $port, $registry);
  46
  47         $self;
  48 }
  49
  50 sub initialise {
  51         my ($self, $mux, $port, $registry) = @_;
  52         my ($sock);
  53
  54         print "ListenerSocket::initialise [$self] mux<$mux> port<$port> " .
  55                 "registry<$registry>\n" if ($main::debug);
  56
  57         # Create a listening socket and add it to the multiplexor.
  58         my $sock = new IO::Socket::INET(Proto     => 'tcp',
  59                                         LocalPort => $port,
  60                                         Listen    => 4,
  61                                         ReuseAddr => 1)
  62                 or die "socket: $@";
  63
  64         print "  adding $self $sock\n" if ($main::debug);
  65         $mux->listen($sock);
  66         $mux->set_callback_object($self, $sock);
  67         $self->{'listener'} = $sock;
  68 }
  69
  70 # Handle new connections by instantiating a new client class.
  71 sub mux_connection {
  72         my ($self, $mux, $fh) = @_;
  73         my ($client);
  74
  75         print "ListenerSocket::mux_connection [$self] mux<$mux> fh<$fh>\n"
  76                 if ($main::debug);
  77
  78         # Make a new client connection.
  79         $client = Client->new($mux, $fh, $self->{'registry'});
  80         print "  new connection $self $client\n" if ($main::debug);
  81 }
  82
  83 sub DESTROY {
  84         my ($self) = @_;
  85
  86         print "ListenerSocket::DESTROY [$self]\n" if ($main::debug);
  87
  88         close($self->{'listener'});
  89 }
  90
  91 #
  92 # CLIENT: general client object, represents a remote client channel
  93 #
  94 package Client;
  95
  96 sub new {
  97         my ($class, $mux, $fh, $registry) = @_;
  98         my $self = bless { 'mux' => $mux,
  99                            'fh'  => $fh,
 100                            'registry' => $registry }, $class;
 101
 102         print "Client::new [$self] mux<$mux> fh<$fh> registry<$registry>\n"
 103                 if ($main::debug);
 104
 105         $self->initialise($mux, $fh, $registry);
 106
 107         $self;
 108 }
 109
 110 sub initialise {
 111         my ($self, $mux, $fh, $registry) = @_;
 112
 113         print "Client::initialise [$self] mux<$mux> fh<$fh> " .
 114                 "registry<$registry>\n" if ($main::debug);
 115
 116         $mux->set_callback_object($self, $fh);
 117 }
 118
 119 sub mux_input {
 120         my ($self, $mux, $fh, $input) = @_;
 121
 122         print "Client::mux_input [$self] mux<$mux> fh<$fh> input<$$input>\n"
 123                 if ($main::debug);
 124
 125         while ($$input =~ s/^(.*?)\n//) {
 126                 my ($cmd, $args) = split(' ', $1, 2);
 127                 my (%args) = Conmux::decodeArgs($args);
 128
 129                 my $reply = {
 130                         'status' => 'ENOSYS',
 131                 };
 132
 133                 # Fill in the common results.
 134                 $reply->{'title'} = 'registry';
 135
 136                 # Handle this command.
 137                 if ($cmd eq "LOOKUP") {
 138                         my $r = $self->{'registry'}->lookup($args{'service'});
 139
 140                         if (defined $r) {
 141                                 $reply->{'result'} = $r;
 142                                 $reply->{'status'} = 'OK';
 143
 144                         } else {
 145                                 $reply->{'status'} = 'ENOENT entry not found';
 146                         }
 147
 148                 } elsif ($cmd eq "ADD") {
 149                         $self->{'registry'}->add($args{'service'},
 150                                 $args{'location'});
 151                         $reply->{'status'} = 'OK';
 152
 153                 } elsif ($cmd eq "LIST") {
 154                         $reply->{'result'} = $self->{'registry'}->list();
 155                         $reply->{'status'} = 'OK';
 156                 }
 157
 158                 $fh->write(Conmux::encodeArgs($reply) .  "\n");
 159         }
 160 }
 161 sub mux_eof {
 162         my ($self, $mux, $fh, $input) = @_;
 163
 164         print "Client::mux_eof [$self] mux<$mux> fh<$fh> input<$input>\n"
 165                 if ($main::debug);
 166
 167         # Handle any pending input, then remove myself.
 168         $self->mux_input($mux, $fh, $input);
 169
 170         # Tell the multiplexor we no longer are using this channel.
 171         $mux->shutdown($fh, 1);
 172 }
 173 sub mux_close {
 174         my ($self, $mux, $fn) = @_;
 175
 176         print "Client::close [$self]\n" if ($main::debug);
 177 }
 178
 179 sub DESTROY {
 180         my ($self) = @_;
 181
 182         print "Client::DESTROY [$self]\n" if ($main::debug);
 183 }
 184
 185 #
 186 # REGISTRY: registry elements.
 187 #
 188 package Registry;
 189
 190 sub new {
 191         my ($class, $store) = @_;
 192         my $self = bless { 'store'  => $store }, $class;
 193
 194         my ($key, $val);
 195
 196         print "Registry::new [$self] store<$store>\n" if ($main::debug);
 197
 198         # Open the store and populate the keys.
 199         open(S, '<', $store) || die "Registry::new: $store: open failed - $!\n";
 200         while (<S>) {
 201                 chomp;
 202
 203                 ($key, $val) = split(' ', $_);
 204
 205                 $self->{'key'}->{$key} = $val;
 206         }
 207         close(S);
 208
 209         $self;
 210 }
 211
 212 sub add {
 213         my ($self, $what, $where) = @_;
 214
 215         my ($key);
 216
 217         print "Registry::add [$self] what<$what> where<$where>\n"
 218                 if ($main::debug);
 219
 220         $self->{'key'}->{$what} = $where;
 221
 222         print "$what at $where\n";
 223
 224         if (open(S, '>', $self->{'store'} . '.new')) {
 225                 foreach $key (sort keys %{$self->{'key'}}) {
 226                         print S "$key $self->{'key'}->{$key}\n";
 227                 }
 228                 close(S);
 229                 rename $self->{'store'} . '.new', $self->{'store'};
 230
 231         } else {
 232                 warn "$P: $self->{'store'}.new: open failed - $!";
 233         }
 234 }
 235
 236 sub lookup {
 237         my ($self, $what) = @_;
 238
 239         print "Registry::lookup [$self] what<$what>\n" if ($main::debug);
 240
 241         $self->{'key'}->{$what};
 242 }
 243
 244 sub list {
 245         my ($self) = @_;
 246         my ($r, $key);
 247
 248         print "Registry::list [$self]\n" if ($main::debug);
 249
 250         foreach $key (sort keys %{$self->{'key'}}) {
 251                 $r .= "$key $self->{'key'}->{$key}\n";
 252         }
 253
 254         $r;
 255 }
 256
 257 #
 258 # MAIN: makes the IO multiplexor, listener and registry and stitches
 259 # them all together.
 260 #
 261 package main;
 262
 263 # Usage checks.
 264 if ($#ARGV != 1) {
 265         print STDERR "Usage: $P <local port> <store>\n";
 266         exit 1
 267 }
 268 my ($lport, $store) = @ARGV;
 269
 270 # Make a new multiplexer.
 271 my $mux  = new IO::Multiplex;
 272
 273 # Make the registry object.
 274 my $registry = Registry->new($store);
 275
 276 # Create the client listener socket.
 277 my $listener = ListenerSocket->new($mux, $lport, $registry);
 278
 279 # Hand over to the multiplexor.
 280 $mux->loop;