conmux/Conmux.pm

   1 #
   2 # Conmux.pm -- core console multiplexor package
   3 #
   4 # Implements the core multiplexor functionality such as resolution of
   5 # names and connecting to the conmux server.
   6 #
   7 # (C) Copyright IBM Corp. 2004, 2005, 2006
   8 # Author: Andy Whitcroft <andyw@uk.ibm.com>
   9 #
  10 # The Console Multiplexor is released under the GNU Public License V2
  11 #
  12 package Conmux;
  13 use URI::Escape;
  14 use File::Basename;
  15 use Cwd 'abs_path';
  16
  17 our $Config;
  18
  19 BEGIN {
  20         my $abs_path = abs_path($0);
  21         my $dir_path = dirname($abs_path);
  22
  23         my $cf = '/usr/local/conmux/etc/config';
  24         if (-e "$dir_path/etc/config") {
  25                 $cf = "$dir_path/etc/config";
  26         } elsif (-e "$dir_path/../etc/config") {
  27                 $cf = "$dir_path/../etc/config";
  28         }
  29
  30         if (-f $cf) {
  31                 open(CFG, "<$cf") || die "Conmux: $cf: open failed - $!\n";
  32                 while(<CFG>) {
  33                         chomp;
  34                         next if (/^#/ || /^\s*$/ || !/=/);
  35
  36                         my ($name, $value) = split(/=/, $_, 2);
  37                         $value =~ s/^"//;
  38                         $value =~ s/"$//;
  39
  40                         # Substitute variables.
  41                         while ($value =~ /\$([A-Za-z0-9_]+)/) {
  42                                 my $v = $Config->{$1};
  43                                 $value =~ s/\$$1/$v/;
  44                         }
  45                         $Config->{$name} = $value;
  46                 }
  47                 close(CFG);
  48         }
  49 }
  50
  51 sub encodeArgs {
  52         my (%a) = @_;
  53         my ($a, $n, $s);
  54
  55         ##print "0<$_[0]> ref<" . ref($_[0]) . ">\n";
  56
  57         # Handle being passed references to hashes too ...
  58         $a = \%a;
  59         $a = $_[0] if (ref($_[0]) eq "HASH");
  60
  61         for $n (sort keys %{$a}) {
  62                 $s .= uri_escape($n) . '=' . uri_escape($a->{$n}) .
  63                         ' ';
  64         }
  65         chop($s);
  66         $s;
  67 }
  68
  69 sub decodeArgs {
  70         my ($s) = @_;
  71         my (%a, $nv, $n, $v);
  72
  73         # Decode the standard argument stream.
  74         for  $nv (split(' ', $s)) {
  75                 ($n, $v) = split('=', $nv, 2);
  76                 $a{uri_unescape($n)} = uri_unescape($v);
  77         }
  78
  79         %a;
  80 }
  81
  82 sub sendCmd {
  83         my ($fh, $c, $a) = @_;
  84         my ($rs);
  85
  86         # Send the encoded command ...
  87         print $fh $c . " " . encodeArgs($a) . "\n";
  88
  89         # Read the reply.
  90         $rs = <$fh>;
  91         chomp($rs);
  92
  93         decodeArgs($rs);
  94 }
  95
  96 sub sendRequest {
  97         my ($fh, $c, $a) = @_;
  98         my %a = { 'result' => 'more' };
  99
 100         # Send the encoded command ...
 101         print $fh $c . " " . encodeArgs($a) . "\n";
 102
 103         %a;
 104 }
 105 sub revcResult {
 106         my ($fh) = @_;
 107         my ($rs);
 108
 109         # Read the reply.
 110         $rs = <$fh>;
 111         chomp($rs);
 112
 113         decodeArgs($rs);
 114 }
 115
 116 #
 117 # Configuration.
 118 #
 119 sub configRegistry {
 120         my $reg = $Config->{'registry'};
 121
 122         $reg = "localhost" if (!$reg);
 123         $reg;
 124 }
 125
 126 # Connect to the host/port specified on the command line,
 127 # or localhost:23
 128 sub connect {
 129         my ($to) = @_;
 130         my ($reg, $sock);
 131
 132         # host:port
 133         if ($to =~ /:/) {
 134                 # Already in the right form.
 135
 136         # registry/service
 137         } elsif ($to =~ m@(.*)/(.*)@) {
 138                 my ($host, $service) = ($1, $2);
 139
 140                 $to = Conmux::Registry::lookup($host, $service);
 141
 142         # service
 143         } else {
 144                 $to = Conmux::Registry::lookup('-', $to);
 145         }
 146
 147         $sock = new IO::Socket::INET(Proto => 'tcp', PeerAddr => $to)
 148                 or die "Conmux::connect $to: connect failed - $@\n";
 149
 150         # Turn on keep alives by default.
 151         $sock->sockopt(SO_KEEPALIVE, 1);
 152
 153         $sock;
 154 }
 155
 156 package Conmux::Registry;
 157 sub lookup {
 158         my ($host, $service) = @_;
 159
 160         $host = Conmux::configRegistry() if ($host eq '-');
 161
 162         # Connect to the registry service and lookup the requested service.
 163         my $reg = new IO::Socket::INET(Proto => 'tcp',
 164                         PeerAddr => "$host", PeerPort => 63000)
 165                 or die "Conmux::connect: registry not available - $@\n";
 166
 167         my %r = Conmux::sendCmd($reg, 'LOOKUP', { 'service' => $service });
 168         die "Conmux::Registry::lookup: $service: error - $r{'status'}\n"
 169                 if ($r{status} ne "OK");
 170
 171         close($reg);
 172
 173         $r{'result'};
 174 }
 175
 176 sub add {
 177         my ($host, $service, $location) = @_;
 178
 179         $host = Conmux::configRegistry() if ($host eq '-');
 180
 181         # Connect to the registry service and lookup the requested service.
 182         my $reg = new IO::Socket::INET(Proto => 'tcp',
 183                         PeerAddr => "$host", PeerPort => 63000)
 184                 or die "Conmux::connect: registry not available - $@\n";
 185
 186         my %r = Conmux::sendCmd($reg, 'ADD', { 'service' => $service,
 187                 'location' => $location });
 188         die "Conmux::Registry::add: $service: error - $r{'status'}\n"
 189                 if ($r{status} ne "OK");
 190
 191         close($reg);
 192
 193         1;
 194 }
 195
 196 sub list {
 197         my ($host, $service, $location) = @_;
 198         my (@results, %r);
 199
 200         $host = Conmux::configRegistry() if ($host eq '-');
 201
 202         # Connect to the registry service and ask for a list.
 203         my $reg = new IO::Socket::INET(Proto => 'tcp',
 204                         PeerAddr => "$host", PeerPort => 63000)
 205                 or die "Conmux::connect: registry not available - $@\n";
 206
 207         %r = Conmux::sendCmd($reg, 'LIST', { });
 208 ##      while ($r{'status'} eq 'more') {
 209 ##              %r = receiveResult($reg);
 210 ##              push(@results, $r{'result'});
 211 ##      }
 212         die "Conmux::Registry::list: error - $r{'status'}\n"
 213                 if ($r{'status'} ne "OK");
 214
 215         close($reg);
 216
 217         $r{'result'};
 218 }
 219
 220 1;