File Coverage

blib/lib/CWB/CQI/Server.pm

Criterion	Covered	Total	%
statement	20	43	46.5
branch	1	14	7.1
condition	0	6	0.0
subroutine	8	9	88.8
pod	2	2	100.0
total	31	74	41.8

package CWB::CQI::Server;
# -*-cperl-*-

use strict;
use warnings;

use CWB::CQI;
use Carp;
use FileHandle;

# export CQi server startup functions
use base qw(Exporter);
our @EXPORT = qw(cqi_server cqi_server_available);

=head1 NAME

CWB::CQI::Server - launch private CQPserver on local machine


=head1 SYNOPSIS

  use CWB::CQI::Server;
  use CWB::CQI::Client;

  if (cqi_server_available()) {
    my @details = cqi_server();
    cqi_connect(@details);
    ...
  }

=head1 DESCRIPTION

The B module can be used to launch a private CQPserver
on the local machine, which B can then connect to.

Note that this is only possible if a suitable version of the IMS Open Corpus Workbench
and the B Perl module have been installed.  Availability must therefore be
checked with the B function before calling B.


=head1 FUNCTIONS

=over 4

=cut

our $CQPserver = undef;
if (eval 'use CWB 3.000_000; 1') {
  $CQPserver = $CWB::CQPserver
    if -x $CWB::CQPserver;
}

=item I<$ok> = B();

Returns a B value if a suitable CQPserver binary is installed on the local machine and
can be started with the B function.

=cut

sub cqi_server_available {
  return (defined $CQPserver) ? 1 : 0;
}

=item (I<$user>, I<$passwd>, I<$host>, I<$port>) = B();

=item I<@details> = B(I<$flags>);

C searches for a free port on the local machine, then
launches a single-user B process and returns the connection details
required by the B function from B (in the appropriate order).
The simplest way to establish a connection with a private, local CQPserver is

    cqi_connect(cqi_server());

Be sure to check with B whether the required C
command-line program is available first.

An optional argument to B is appended to the C command-line flags
and can be used to specify further start-up options (e.g. to read a macro definition file).
Keep in mind that arguments containing shell metacharacters need to be quoted appropriately.

B Since B runs as a separate process in the background, it is
important to establish a connection B. If the user's
program aborts before B is called and contacts the new CQPserver,
this process will accept further connections from other users (on the local machine),
which might compromise confidential data.

=cut

#
#
#  Start CQPserver in the background and return (host, port, user, passwd) list for cqi_connect()
#  An init file is generated which adds a random user/passwd to the server's user list,
#  so you can connect to the newly created server with the user/passwd combination returned
#  by cqi_server() only. (NB uses '-I' at the moment, so .cqprc won't be read)
#
#
sub cqi_server {
  my $user = "cqi_server_$$";
  my $passwd = "pass" . int rand(42000);
  my $flags = "-1 -L -q ";      # single-client server, localhost only (for security reasons)
  $flags .= "@_" if @_;         # append optional command-line flags

  croak "CQPserver is not installed on this machine"
    unless cqi_server_available();

  # generate temporary user list file for CQPserver
  my $passfile = "/tmp/CQI::Server.$$";
  my $fh = new FileHandle "> $passfile";
  croak "Can't create temporary user list file. Aborting."
    unless defined $fh;
  print $fh "user $user \"$passwd\";\n";
  $fh->close;
  chmod 0600, $passfile;        # so no one can spy on us

  # scan for free port (using rand() so two servers invoked at the same time won't collide)
  my $port = 10000 + int rand(2000);
  my %in_use =
    map {$_ => 1}
      map {(/\*\.([0-9]+)/) ? $1 : 0}
        `netstat -a -n | grep LISTEN`;
  while ($port < 60000 and $in_use{$port}) {
    $port += rand(20);          # jump randomly to avoid collisions
  }
  croak "Can't find free port for CQPserver. Abort."
    unless $port < 60000;

  # now start CQPserver on this port
  croak "CQPserver failed to launch: $!\n"
    if system "$CQPserver $flags -P $port -I $passfile >/dev/null 2>&1" or $? != 0;

  # delete user list file
  unlink $passfile;

  # return connection information suitable for cqi_connect()
  return $user, $passwd, "localhost", $port;
}


1;

__END__