package INSTALL::services;

use IO::Seekable;

BEGIN {
  # An array of all port numbers currently found in the services file.
  # @ports = ();

  ## We require that we can write to the services file before we can continue.
  $services = "/etc/services";

  # find out what ports are already in use /etc/services
  local *SERVICES;
  open(SERVICES, "<$services") || die "Could not open /etc/services file";
  while ($line = <SERVICES>)
  {
    if ($line =~ /\w+\s+(\d+)-(\d+)\/tcp/) { push @ports,($1 .. $2); }
    if ($line =~ /\w+\s+(\d+)\/tcp/) { push @ports,$1; }
  }

  close(SERVICES);

  # Sort them.
  @ports = sort {$a <=> $b} @ports;
}

sub invalidate_ports
{
  ($#_ == 1) || die "Invalid number of arguments.";

  my ($port_base,$port_count) = @_;

  push @ports, ($port_base .. ($port_base + $port_count - 1));
  @ports = sort {$a <=> $b} @ports;
  return(1);
}

sub validate_free_ports
{
  ($#_ == 1) || die "Invalid number of arguments.";

  my ($port_base,$port_count) = @_;

  sub in_range {
    my ($port,$port_base,$port_count) = @_;

    if (($port >= $port_base) && ($port < ($port_count + $port_base))) {
      return($port);
    }
    else {
      return(undef);
    }
  }


  my @invalid_ports = grep { in_range($_,$port_base,$port_count) } @ports;

  if ($#invalid_ports >= 0)  {
    return(0);
  }
  else {
    return(1);
  }
}

sub locate_free_ports
{
  ($#_ == 1) || die "Invalid number of arguments.";

  my ($port_base, $port_count) = @_;

  sub above_range {
    my ($port,$port_base) = @_;

    if ($port >= $port_base) {
      return($port);
    }
    else {
      return(undef);
    }
  }

  my @valid_ports = grep { above_range($_,$port_base) } @ports;
  my $i;

  if (($#valid_ports < 0) || ($valid_ports[0] >= ($port_base + $port_count))) {
    return($port_base);
  }
  else {
    for($i = 0; $i < $#valid_ports; $i++) {
      if (($valid_ports[$i] + $port_count) < $valid_ports[$i+1]) {
        return($valid_ports[$i] + 1);
      }
    }
    return($valid_ports[$#valid_ports] + 1);
  }
}

sub allocate_free_ports
{
  ($#_ == 1) || ($#_ == 2) || die "Invalid number of arguments.";

  my $port_base;
  my $port_count;
  my $port_comment;
  local *SERVICES;

  if ($#_ == 1) {
    ($port_base, $port_count) = @_;
  }
  else {
    ($port_base, $port_count, $port_comment) = @_;
  }

  chmod(0644, $services);
  open(SERVICES,">>$services") || die "Unable to open the $services file in INSTALL::services::allocate_free_ports.";

  my $base_port = locate_free_ports($port_base, $port_count);
  my $i;

  if ($port_comment) {
    $port_comment = " - $port_comment";
  }

  for($i=0; $i < $port_count; $i++) {
    my $port = $base_port + $i;

    print SERVICES "casp$port\t$port/tcp\t\t\t# $base_port$port_comment\n";
    push @ports,$port;
  }

  # Resort the ports.
  @ports = sort {$a <=> $b} @ports;

  close(SERVICES);
  chmod(0444, $services);

  return($base_port);
}


# Identical to allocate_free_ports, but the specified base port will be used
# regardless of whether or not it is already in use (god forbid!).
sub allocate_ports
{
  ($#_ == 1) || ($#_ == 2) || die "Invalid number of arguments.";

  my $port_base;
  my $port_count;
  my $port_comment;
  local *SERVICES;

  if ($#_ == 1) {
    ($port_base, $port_count) = @_;
  }
  else {
    ($port_base, $port_count, $port_comment) = @_;
  }

  chmod(0644, $services);
  open(SERVICES,">>$services") || die "Unable to open the $services file in INSTALL::services::allocate_free_ports.";

  my $base_port = $port_base;
  my $i;

  if ($port_comment) {
    $port_comment = " - $port_comment";
  }

  for($i=0; $i < $port_count; $i++) {
    my $port = $base_port + $i;

    print SERVICES "casp$port\t$port/tcp\t\t\t# $base_port$port_comment\n";
    push @ports,$port;
  }

  # Resort the ports.
  @ports = sort {$a <=> $b} @ports;

  close(SERVICES);
  chmod(0444, $services);

  return($base_port);
}

# Returns non-zero on success.
# Takes either 1 or 2 parameters, the first being the port base
# and the second (optional parameter) being a port count.
# Using two parameters rather than one does something different
# in terms of matching.  Namely:
#   If 1 parameter is passed (ie. the port base), the entries
#   made via this module can be detected merely by their bases.
#   In this way, any port created via using this base will be
#   removed.
#
#   If 2 parameters are passed (ie. the port base and a count),
#   any entries matching the specified base port to
#   (<base port> + <count> - 1) will be deleted.
sub deallocate_ports
{
  ($#_ == 0) || ($#_ == 1) || die "Invalid number of arguments.";

  my $port_base;
  my $port_count;
  my $matching_scheme;

  if ($#_ == 0) {
    ($port_base) = @_;
    $matching_scheme = 0;
  }
  else {
    ($port_base, $port_count) = @_;
    $matching_scheme = 1;
  }

  local *SERVICES_SRC;
  local *SERVICES_UPDATE;

  chmod(0644, $services);
  open(SERVICES_SRC,"<$services") || die "Unable to open the $services file in INSTALL::services::deallocate_ports.";

  rename("$services","$services.chilasp-temp");

  unless (open(SERVICES_UPDATE,">$services")) {
    rename("$services.chiliasp-temp",$services);
    print "Error: Unable to create new services file.\n";
    return(undef);
  }

  my @original = <SERVICES_SRC>;
  my @new;

  close(SERVICES_SRC);

  if ($matching_scheme == 1) {
    # Match the port explicitly, and remove it.  This functionality can be used to
    # deallocate both ports allocated via allocate_ports and ports allocated by
    # users proper.
    my @ports = ($port_base .. ($port_base + $port_count - 1));

    my $port_pattern=join("|",@ports);

    foreach (@original) {
      if (not m@\s($port_pattern)\s*/tcp.*@) {
        push @new,$_;
      }
    }
  }
  else {
    foreach (@original) {
      if (not m@casp[0-9]+\s+([0-9]+)\s*/tcp\s+\# $port_base@) {
        push @new,$_;
      }
    }
  }

  foreach (@new) {
    print SERVICES_UPDATE $_;
  }

  close(SERVICES_UPDATE);
  unlink("$services.chiliasp-temp");

  # Add the ports back into the free list ...
  # (or actually remove them from the taken list).
  my %port_hash = map { ($_ => undef) } @ports;

  foreach($port_base .. ($port_base + $port_count - 1)) {
    delete $port_hash{$_};
  }

  @ports = sort { $a <=> $b } keys %port_hash;
  return(1);
}

1;