#!/usr/bin/perl

# xconv2.pl - Gordon Haverland (perl\@materialisations.com)
# Copyright 2005, License is your choice of GPL or The Artistic
# License, as is typical of many perl programs/modules.

# Rewrite of xconv.pl to try and get it to help clean things up a bit.
# Debian really doesn't have any way of supporting people who use xinetd.
# It (seems to) think the solution is to just run inetd.conf through
# xconv.pl and that produces something which works.  Well, my
# inetd.conf got screwed up just from updates, and has multiply defined
# services in it.  Inetd.conf also has special comments in it for things
# which should probably pass through to xinetd.conf, and also for
# enabling/disabling and turning on/off services (what is the difference
# between enable/disable and on/off???).  Treat them as the same for now.
# A single line of inetd.conf that is not a comment, is translated into
# multiple lines in xinetd.conf.  Xconv.pl was written as a filter, it
# read STDIN and wrote to STDOUT.  This version only reads /etc/inetd.conf
# and writes to STDOUT.  In addition, it reads /etc/protocols to extract
# all the "officially" supported protocols at that site.  It generates
# warnings for lots of things, probably too many.  It will die over a
# number of conditions.  I think these conditions are unusual, and should
# be looked at before going on to work with xinetd.  I could be wrong.

sub print_header;
sub print_defaults;

print_header;
print_defaults;

open( PROTOCOLS, "< /etc/protocols" ) ||
  die "Can't read in known protocols from /etc/protocols: $!\n";
# Internally, all protocols are converted to lower case before being
# tested for existance.  But the difference between the first and third
# columns of /etc/protocols isn't limited to just case.  So, we need to
# examine both columns.  Do I need to remember port numbers?  If I need
# a hash to remember stuff with, I need to stick something in the value
# part of a hash element, so I might as well.  The only problem then might
# be IP, which has a protocol number of 0 (and apparently hopopt for IPv6
# also shares this property).
while( $line = <PROTOCOLS> ) {
  chomp( $line );
  $line =~ s/^\s+//;      # Get rid of leading/trailing whitespace
  $line =~ s/\s+$//;

  next if( $line =~ /^\#/ );       # Ignore comments and empty lines
  next if( length( $line ) < 1 );

  $line =~ s/\s*\#.*$//;            # Get rid of trailing comments

  @token = split( /\s+/, $line );  # $#token should always be 2
  die "Strange number of tokens in /etc/protocol for ($line)\n"
    unless( $#token >= 2 );  # 73 rspf is RSPF CPHB    Should I generate 2????
  $third = lc( $token[2] );
  if( exists( $pseen{$token[0]} ) ) {
    die "Error, protocol $token[0] seen previously\n";
  }
  if( exists( $pseen{$third} ) ) {
    die "Error, protocol $token[2] seen previously\n";
  }
  $pseen{$token[0]} = $token[1];
  $pseen{$third}    = $token[1] unless( exists( $pseen{$third} ) );
}
close( PROTOCOLS );
@protocols = keys( %pseen );

close( STDIN );
open( STDIN, "< /etc/inetd.conf" ) ||
  die "Can't open /etc/inetd.conf for input: $!\n";


while( $line = <STDIN> ) {
  chomp( $line );
  $line =~ s/\s+$//;      # Get rid of trailing space now.

  # We need to deal with comments.  A line which starts with '#<off># '
  # should be accepted as a service, but commented out.
  if( ($line =~ /^\#<off>\#\s*(.*)$/)    ||
      ($line =~ /^\#disabled\#\s*(.*)$/)    ) {
    my $h = &save_command( $1 );
    $h->{commented_out} = 1;
    push( @input, $h );
    next;
  }

  # We have service headers with #:TITLE: blurb
  if( $line =~ /^\#:([^:]*):\s*(.*)/ ) {
    my $key  = 'comment ' . lc( $1 );
    warn "Input warning: multiple occurances of comment header $1\n"
      if( exists( $seen{$key} ) );
    $seen{$key}++;
    $disabled{lc($1)}++;
    my $desc  =  $2;
    $desc     =~ s/\s+$//;
    my $h     =  {};
    my $title = uc( $1 );
    $h->{comment} = "#:$title: $desc";
    push( @input, $h );
    next;
  }

  if( ($line =~ /^\#/)   ||
      ($line =~ /^\s*$/)    ) {
#    push( @comments, $_ );
    next;
  }

  # What's left?  Why, command lines.  Strip leading space (shouldn't
  # be there anyway).
  $line    =~ s/^\s+//;
  @command =  split( /\s+/, $line );
  $seen{lc($command[0])}++;

  warn "Warning: $command[0] exists in inetd.conf as a debconf disabled item\n"
    if( exists( $disabled{$command[0]} ) );
  warn "Warning: $command[0] exists earlier in inetd.conf as well\n"
    if( exists( $seen{lc($command[0])} ) );

  my $h = &save_command( $line );
  push( @input, $h );
}
close( STDIN );

# The input file has been all read at this point.  If there are
# active control lines which deal with control lines commented out
# by debconf, these probably should be removed (or the config in
# debconf changed to reflect that someone has added those lines
# back in).  If active control lines are present for the same
# service, all but one of them should be removed.  I would guess
# that a person keeps the first and removes the rest, but it
# might be that you keep the last and delete all the previous
# ones.  In any case, warnings were issued and so the source file
# can be edited to remove the extraneous service lines.

# Each element of @output is a reference to a hash.  If the key
# "commented_out" exists, it means the command in the source file
# was commented out under control of debconf.  If the key "comment"
# exists, it means the line is a Service Header comment.  If
# the key "command" exists, it is an array of tokens on a service
# line.

# Cleanup the input by only keeping the first occurance of a service.
foreach my $i (@input) {
  if( exists( $i->{command} ) ) {
    my $Cmd = $i->{command};
    my $cmd = lc( $Cmd->[0] );
    if( ! exists( $seen2{$cmd} ) ) {
      $seen2{$cmd}++;
      push( @output, $i );
    }
  } else {
    push( @output, $i );
  }
}

# Okay, process the cleaned service/comment lines.  Comment lines go out,
# as is.  Apparently we want to skip over RPC services, since xinetd
# apparently still doesn't do RPC well.  A newer tutorial dated July of
# 2004 at MacSecurity.org still states that xinetd doesn't do RPC well.
# I don't know, but if xinetd is being advertised as a replacement for
# inetd, shouldn't someone get xinetd doing RPC at least as well as inetd
# so that it can in fact be a replacement?  We must check for RPC first,
# as some RPC services are combined with other protocols (i.e. rpc/tcp).
# We could check for other valid protocols, by looking in the contents of
# /etc/protocols.
foreach my $o (@output) {
  if( exists( $o->{comment} ) ) {
    print "$o->{comment}\n";

  } elsif( exists( $o->{command} ) ) {
    my $cmd = $o->{command};
    my $pcol = lc( $cmd->[2] );
    if( $pcol =~ /^rpc$/ ) {
      warn "Warning: Service $cmd->[0] not added to xinetd.conf " .
	"because xinetd does not handle RPC services well.";
      next;

    } else {
      if( grep /^$pcol$/, @protocols ) {   # This is the main method
	# Generate the stanza in parts, to be concatenated together.
	$start    = &start_service( $cmd );
	$unlisted = &unlisted_service( $cmd );
	$wait     = &wait_service( $cmd );
	$user     = &user_service( $cmd );
	$amanda   = &amanda_service( $cmd );
	$server   = &server_service( $cmd );
	$finish   = &finish_service( $cmd );

	my @lines = split( /\n/,
			   $start .
			   $unlisted . $wait . $user . $amanda . $server .
			   $finish );
	if( exists( $o->{commented_out} ) ) {
	  foreach (@lines) {
	    s/^(.)/\#$1/;
	  }
	  unshift( @lines, '#<off>#');
	}

	print join "\n", @lines;

      } else {
	warn "Warning: Service $cmd->[0] is not tcp or udp (rpc not done by xinetd), but adding anyway.";
      }
      print "\n\n";
    }

  } else { # Impossible.  Either command or comment must be present.
    my $keys = join ' ', keys( %{$o} );
    die "Error: Unknown xconv2 conversion.  Keys are ($keys)\n";
  }
}


sub save_command {
  my $line = shift;
  my $a    = [];
  my $h    = {};
  @{$a}    = split( /\s+/, $line );
  $h->{command} = $a;
  return $h;
}


sub start_service {
  my $command = shift;

  my $str = <<"EOS";
service $command->[0]
{
  socket_type    = $command->[1]
  protocol       = $command->[2]
EOS
  return $str;
}


sub unlisted_service {
  my $command = shift;
  my $str;

  if( $command->[0] =~ /^\d+$/ ) {
    $str = <<"EOS";
  port           = $command->[0]
  type           = UNLISTED
EOS
  } else {
    $str = undef;
  }
  return $str;
}


sub wait_service {
  my $command = shift;
  my $str;
  if( $command->[3] =~ /no/i ) {
    $str = "  wait           = no\n";
  } else {
    $str = "  wait           = yes\n";
  }
  return $str;
}


sub user_service {
  my $command = shift;
  my @user = split( /\./, $command->[4] );
  my $str = "  user           = $user[0]\n";
  if( defined( $user[1] ) ) {
    $str .= "  group          = $user[1]\n";
  }
  return $str;
}


sub amanda_service {
  my $command = shift;
  my $str = undef;

  # Amanda is a special case, and needs this to run properly.  See
  # http://www.amada.org/docs/install.html and Debian bug report
  # #167367.

  # Can we anchor the search expression at the end?  GH
  $str = "  groups         = yes\n"
    if( $command->[6] =~ /(amandad|amindexd|amidxtaped)/ );
  return $str;
}


sub server_service {
  my $command = shift;
  my $str;
  # We might want to just look at the list of internal services to see
  # if this service is internal.  Inetd has: echo, discard, chargen,
  # daytime, time.  Xinetd has the same services as internal.
  if( $command->[5] =~ /^internal$/i ) {
    if( $command->[0] =~ /^(echo|discard|chargen|daytime|time)$/i ) {
      $str  = "  type           = INTERNAL\n";
      $str .= "  id             = $command->[0]-$command->[1]\n";

    } else {
      die "Error: Service $command->[0] is NOT an INTERNAL service!\n";
    }

  } elsif( $command->[5] =~ m|^/usr/sbin/tcpd$|i ) {
    # While /usr/sbin might be the usual home for tcpd on Debian, I can
    # think of valid reasons for it to be /usr/local/sbin.  Some people
    # might put it elsewhere.  Tcp-wrapping is implemented internally in
    # xinetd.
    $str = "  server         = $command->[6]\n";
    if( defined( $command->[7] ) ) {
      $str .= "  server_args    = ";
      for( my $i = 7; $i <= $#{$command}; $i++ ) {
	$str .= "$command->[$i] ";
      }
      chop( $str );  # One too many spaces
      $str .= "\n";
    }

  } else {  # Not internal or tcpd
    $str =  "  server         = $command->[6]\n";
    $str .= "  server_args    = ";
    for( my $i = 6; $i <= $#{$command}; $i++ ) {
      $str .= "$command->[$i] ";
    }
    chop( $str );
    $str .= "\n";
  }
  return $str;
}


sub finish_service {
  my $command = shift;
  my $str = "}\n";
  return $str;
}


sub print_header {
  print <<"EOS";
# This file generated by xconv2.pl.  xconv2.pl was written by
# Gordon Haverland (perl\@materialisations.com).

# The file is a translation of your inetd.conf file into
# the equivalent xinetd.conf syntax.  Some cleanup of the
# file is done (first definition seen is followed), and HEADER
# comments are carried through.  Services commented out by debconf
# are carried through as well.  Xinetd has many features that
# may not be taken advantage of with this translation.  Please
# refer to the xinetd.conf(5) man page for more information
# on how to (more) properly configure xinetd.


EOS
}

sub print_defaults {
  print <<"EOS";
#:DEFAULTS: The defaults section sets some information for all services
defaults
{
  # The maximum number of requests a particular service may handle
  # at once.
  instances      = 25

  # The type of logging.  This logs to a file that is specified.
  # Another option is: SYSLOG syslog_facility [syslog_level]
  log_type       = FILE /var/log/servicelog

  # What to log when the connection succeeds.
  # PID logs the pid of the server processing the request.
  # HOST logs the remote host's IP address.
  # USERID logs the remote user (using RFC 1413, ident).
  # EXIT logs the exit status of the server.
  # DURATION logs the duration of the session.
  log_on_success = HOST PID

  # What to log when the connection fails.  Same options as above.
  log_on_failure = HOST

  # The maximum number of connections a specific address can
  # have to a specific service.
  per_source     = 5

  # Apparently servers/services/xadmin are unprotected, and should only
  # be used at configuration time.  Let's just disable them by default.
  # Per LinuxFocus tutorial article.
  disabled       = servers services xadmin
}

EOS
}