#!/usr/bin/perl

# xinetd_admin.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.

# This is a program which is meant to make incremental changes to xinetd.conf
# via command line arguments.  Service stanzas can be commented out or
# activated by single command line arguments.  Individual capabilities of a
# service can also be added or subtracted on the command line.  Since a service
# name is NOT unique, but rather it is the combination of service name and
# protocol, it is recommended that changes be done using name:protocol format.

# This program preserves the order in which comments are made, and the order in
# which services are listed.  It does not preserve the position of comments,
# the order of capabilities within a service, or the "tabbing/formatting" of
# capabilities.

# Usage: xinetd_admin.pl [-D]
#                        [-service NAME[:PROTOCOL]]
#                        [+service NAME[:PROTOCOL]]
#                        [*service NAME[:PROTOCOL] *cap=stuff]
# -I/path/to/FILE        Input FILE to read.
# -D                       Set debugging flag (output to STDERR)
# -service NAME            Comment out service of NAME.
# +service NAME            Uncomment service of NAME.
# *service NAME *cap=stuff Add/remove cap=... of service NAME
# NAME[:PROTOCOL]          The combination of NAME:PROTOCOL is unique, NAME
#                          isn't.

# Parses the xinetd.conf file produced by my xconv2.pl program, and also some
# variations on that format, and makes changes as directed on the command line.

# This program assumes that the structure of the xinetd.conf file is:
# # This file ...
# ...
# #:defaults: The defaults section set some information for all services
# defaults
# {
#  # Comment or               (blanks lines allowed to)
#  instruction = something
#
#  ...
# }
# 
# #:label:pcol: Label is optional, but it can start a service stanza
#               pcol is the protocol.  The Label:pcol combination is unique to
#               a service instance.
# # comment, is optional
# service label
# {
#  #Interior, same as defaults
# }
# #service turned off
# #{
# # #Interior, same as defaults
# #}

# The program starts, assuming the header section is the active section.
# We read until we see something else started (probably defaults).
# The start of a stanza is one of the following:
#  #:label:[pcol:] Which starts a service called label with protocol pcol
#  service label
#  #service label
#  defaults
#  #defaults
# A stanza ends with one of the following:
#  }
#  #}
#  End-Of-File
# We don't actually do much with stanza endings, other than note they occur.
# If we see #service, #defaults or #{ at the beginning of a line, we assume
# that the stanza is NOT active.  If we see something like:
#  service XXX
#  #{
# we assume the entire stanza is NOT active.  That first line will get changed
# to #service XXX on printing.

# This program is written more to function and be easy to maintain, than
# it is to be fast.  No doubt it could be sped up considerably, and I suspect
# some perl gods could make it much more elegent as well.

# Process a little of the command line.  Look for -D (debugging) flags,
# and arguments specifying a non-default input filename.  Push everything
# else onto an internal CMDARGV array.
my @CMDARGV;
my $input_file = '/etc/xinetd.conf';
$DEBUG = 0;
foreach (@ARGV) {
  if( $_ =~ /^-D$/ ) {
    $DEBUG++ 
  } elsif( $_ =~ /^-I(.*)$/ ) {
    $input_file = $1;
  } else {
    push( @CMDARGV, $_ );
  }
}

open( CONF, "< $input_file" ) ||
  die "Can't open $input_file to read it. $!\n";

# Initialise our state machine.
$state      = 'header';
$protocol   = '';
$in_stanza  = 0;
$strip_c    = 0;           # We are not stripping leading hash marks to begin
$seen_admin = 0;
$admin = << 'EOS';
#:xinetd_admin: This file administered by xinetd_admin.pl.  The only
# changes you should be making to this file are the presence or locations
# of comments, if needed.  This program has some very specific ideas as
# to where comments should be, and moves them.  Warnings generated by
# xinetd_admin.pl may not effect how xinetd runs.  It doesn't do very
# complete checks for multiply defined services, for instance.
#
EOS


# Start tracking service stanzas, starting with an active header section.
my @stanzas;
$H = {
      'header' => {
		   inactive => 0,
		   comment  => [],
		   data     => {},  # Instructions in arbitrary order?
		  }
     };

push( @stanzas, $H );


# Read in file.
while( $line = <CONF> ) {
  chomp( $line );
  next if( $line =~ /^\s*$/ );  # Skip empty lines.

  # Look for our header.
  $seen_admin = 1 if( $line =~ /^\#:xinetd_admin:/ );

  my( $new_state, $inactive );
  my $t = $stanzas[-1];         # Point to last active stanza

  # Look to see if this line, starts a new stanza
  ( $new_state, $inactive ) = &is_new_state( $line );

  my $h;
  if( $new_state ) {
    my $tmp = {
	       $new_state => {	
			      inactive => $inactive,
			      comments => [],
			      data     => {},
			     }
	      };
    $states{$new_state} = [] unless exists( $states{$new_state} );
    push( @stanzas,               $tmp );
    push( @{$states{$new_state}}, $tmp );

    $protocol = '';
    $state    = $new_state;
    $h        = $tmp->{$state};

  } else {
    die "Impossible state=$state\n" unless exists $t->{$state};
    $h = $t->{$state};
  }

  if( $new_state ) {
    # Look for comments to save away on lines which trigger a new state.
    $strip_c = 0;     # Reset flag to strip comment delimiters
    if( $line =~ /^\#?service\s+\S+(\#.*)$/i ) {
      $com = $1;
    } elsif( $line =~ /^\#?defaults\s+(\#.*)$/i ) {
      $com = $1;
    } elsif( $line =~ /^\#:[^:]+:([^:\#\s]+:)?(.*)$/ ) {
      $com = "# $1";
    }
    if( $com ) {
      # These particular comments, we can suck leading/trailing space out of.
      $com =~ s/^\s+//;
      $com =~ s/\s+$//;
      push( @{$h->{comments}}, $com );
    }

  } else {  # Is line in existing stanza
    $in_stanza = 0 if( $line =~ /^\#?\}/ );  # We look for end of stanza first.

    # We are filling in pre-stanza comments, stanza comments and
    # stanza/service capabilities.
    $inactive = $h->{inactive};        # Get current state of inactive flag.
    if( $line =~ /^\#\{/ ) {
      $h->{inactive} = $inactive = 1;  # Set this stanza as INACTIVE
      $strip_c = 1;
    }

    # We strip comments characters from beginning of all lines of stanza, if it
    # is commented out.
    $line    =~ s/^\#// if $strip_c;
    $strip_c = 0        if( $line =~ /^\}/ );

    # Look for comments to save, in "bad" places.
    if( $line =~ /^\s*\#/ ) {                   # Comment line
      push( @{$h->{comments}}, $line );
    } elsif( $line =~ /^\{\s*(\#.*)$/ ) {       # Comment on stanza beginning
      push( @{$h->{comments}}, $1 );
    } elsif( $line =~ /^\}\s*(\#.*)$/ ) {       # Comment on stanza ending
      push( @{$h->{comments}}, $1 );
    } elsif( $line =~ /^\#?defaults\s+(\#.)+$/ ) { # defaults w comment
      push( @{$h->{comments}}, $1 );
    } elsif( $line =~ /^\#?service\s+\S+\s+(\#.)+$/ ) { # service w comment
      push( @{$h->{comments}}, $1 );
    } elsif( $line =~ /^\#?(defaults|service)/ ) { # stanza start
      # Do nothing
    } elsif( $line =~ /^\{/ ) { # stanza start
    } elsif( $line =~ /^\}/ ) { # stanza end
    } else {                    # Must be data.
      if( $in_stanza && $line =~ /^\s*([^=\s]+)\s*=\s*(.*)$/ ) {
	my $d      =  $h->{data};
	$cmd       =  lc $1;
	$parg      =  $2;
	$parg      =~ s/^\s+//;
	$parg      =~ s/\s+$//;
	$d->{$cmd} =  $parg;
	if( $cmd =~ /^protocol$/i ) {
	  $parg    = lc( $parg );
	  my $sp   = "$state:$parg";
	  $SP{$sp} = [] unless exists( $SP{$sp} );
	  push( @{$SP{$sp}}, $t );
	}
      } else {           # Hmmm, not in_stanza, or strange line
	my $l = $line;
	$l =~ s/^\s+//;
	$l =~ s/\s+$//;
	print STDERR "Unknown xinetd.conf in-stanza data line ($l)\n" if $DEBUG;
      }
    }
    $in_stanza = 1 if( $line =~ /^\#?\{/ );
  }
}

print $admin unless $seen_admin;

# If DEBUG, print out our interpretation of existing xinetd.conf
&print_stanzas() if( $DEBUG );

# Okay, go through command line, modifying our tree.
while (@CMDARGV) {
  my $arg = shift( @CMDARGV );

  my( $h, $name);
  if( $arg =~ /^-?-service/i ) {       # -service  or --service
    unshift @CMDARGV, $arg;
    &service();

  } elsif( $arg =~ /^\+service/i ) {  # +service
    unshift @CMDARGV, $arg;
    &service();

  } else {                    # Huh?
    die "Bad command line, expecting [-+]service, got ($arg)\n";
  }
}

&print_stanzas();

# Subroutines follow.
sub is_new_state {
  my $line = shift;
  my $new_state;

  my $inactive = 0;
  if( $line =~ /^\#service\s+(\S+).*$/i ) {  # Turned off service stanza
    $new_state  = lc $1;
    $inactive = 1;
  } elsif( $line =~ /^\#defaults.*$/i ) {    # Turned off defaults stanza
    $new_state  = 'defaults';
    $inactive = 1;
  } elsif( $line =~ /^\#:([^:]+):([^:\#\s]+:)?/ ) { # Header line preceeding stanza
    $new_state  = lc $1;
  } elsif( $line =~ /^defaults/i ) {         # defaults stanza
    $new_state  = 'defaults';
  } elsif( $line =~ /^service\s+(.*)$/i ) {  # service stanza
    $new_state  = lc $1;
  }
  return( $new_state, $inactive );
}

sub print_stanzas {
  foreach my $stanza (@stanzas) {
    print STDERR "STANZA------------------------------------------\n"
      if( $DEBUG );
    my @states = keys( %{$stanza} );
    my $state;
    my $sp;
    if( $#states == 0 ) {
      $state = $states[0];
      my $s = $stanza->{$state};
      next if exists( $s->{delete} ) && $s->{delete};  # Skip, if marked
      my $d = $s->{data};
      $sp  = "$state";
      $sp .= ":$d->{protocol}" if exists $d->{protocol};
      my $nsp = $#{$SP{$sp}}+1;
      print STDERR
	"State=$state multiply defined!  ($nsp times)\n"
	  if( $#{$SP{$sp}} > 0 );

    } else {
      my $n = $#states;
      die "Improper number of states for stanza ($n)\n";
    }
    my $h = $stanza->{$state};
    my $c = $h->{inactive} ? '#' : '';
    $sp   = $sp ? $sp : $state;
    print "#:$sp:\n" unless $state eq 'header';
    foreach my $com (@{$h->{comments}}) {
      if( $com =~ /^\#/ ) {
	print $c, "$com\n";
      } else {
	last;
      }
    }
    next if $state eq 'header';
    if( $state eq 'defaults' ) {
      print $c, "$state\n";
    } else {
      print $c, "service $state\n";
    }
    print $c, "{\n";
    foreach my $com (@{$h->{comments}}) {
      next if( $com =~ /^\#/ );
      print $c, "$com\n";
    }
    my $d = $h->{data};
    foreach my $dat (keys(%{$d})) {
      print $c, "  $dat = $d->{$dat}\n";
    }
    print $c, "}\n\n";
  }
}

sub service {
  my( $name, $protocol, $sp, $delete, $add );

  # This routine gets called, when an argument on the command line
  # looks like -service, +service or --service.  Once it has finished
  # locating the stanza in question, and either marking it for being
  # inactive or deletion, it calls capabilities() to look for related
  # capability arguments which are following it on the command line.
  my $arg = shift( @CMDARGV );
  $add = 0;
  $add = 1 if $arg =~ /^\+/;
  if( $arg =~ /^--service(\S+)$/i ) {  # We are deleting a service completely.
    $name = $1;
    $delete++;
  } elsif( $arg =~ /^--service\s*=\s*(\S+)$/i ) {
    $name = $1;
    $delete++;
  } elsif( $arg =~ /^--service$/i ) {  # --service NAME    ??
    $name = shift @CMDARGV if( $ARGV[0] !~ /^-?[-+]service/i );
    $delete++;
  } elsif( $arg =~ /^[-+]service(\S+)$/i ) {
    $name = $1;
  } elsif( $arg =~ /^[-+]service\s*=\s*(\S+)$/i ) {
    $name = $1;
  } else {  # [-+]service NAME    ??
    $name = shift @CMDARGV if( $ARGV[0] !~ /^-?[-+]service/i );
  }
  $name = lc $name if $name;
  # Is there something here to work with?  No?  Bail.
  return unless $name;

  # We have a name, and a protocol
  if( $name =~ /^([^:]+):([^:]+)$/ ) {
    $name     = lc $1;
    $protocol = lc $2;
    $sp       = "$name:$protocol" if $protocol;

  } elsif( $name =~ /^([^:]+)$/ ) {  # Just a name
    $name     = lc $1;
  }

  # Look through stanzas for name/protocol.
  if( $sp && exists( $SP{$sp} ) ) {           # We have that name:protocol
    die "Multiply defined $sp ($#{$SP{$sp}})\n"
      if( $#{$SP{$sp}} > 0 );
    my $a = $SP{$sp};
    my $h = $a->[0];
    if( exists $h->{$name} ) {
      my $t = $h->{$name} ;
      $t->{inactive} = $add ? 0 : 1;
      $t->{delete}   = 1 if $delete;
    }

    &capabilities( $h, $name );
    return;

  } elsif( $name && exists( $states{$name} ) ) {  # We have that name
    # How do we get a service NAME without a protocol?  (Except
    # defaults/header, and they can't be multiple either.)
    if( $name =~ /^(header|defaults)$/ ) {
      die "Multiply defined $name ($#{$states{$name}})\n"
	if( $#{$states{$name}} > 0 );
      my $a = $states{$name};
      my $h = $a->[0];
      if( exists $h->{$name} ) {
	my $t = $h->{$name} ;
	$t->{inactive} = $add ? 0 : 1;
	$t->{delete}   = 1 if $delete;
      }
      &capabilities( $h, $name ) if $name eq 'defaults';
      return;

    } else {  # Something other than header or defaults
      return;
    }

  } else {                              # Doesn't already exist, build it.
    my $tmp = {
	       $name => {	
			 inactive => $add ? 0 : 1,
			 comments => [],
			 data     => {},
			}
	      };
    if( $protocol ) {
      my $n          = $tmp->{$name};
      my $d          = $n->{data};
      $d->{protocol} = $protocol;
      $SP{$sp}       = [] unless exists $SP{$sp};
      push( @{$SP{$sp}}, $tmp );
    }
    $states{$name} = [] unless exists( $states{$name} );
    push( @stanzas,          $tmp );
    push( @{$states{$name}}, $tmp );

    &capabilities( $tmp, $name );

    return;
  }
}

sub capabilities {
  my $h    = shift;
  my $name = shift;
  my @states = keys( %{$h} );
  die "Capabilities: Bad hash ($#{$states})\n" if( $#states != 0 );
  die "Capabilities: expecting service=$name not $states[0]\n"
    if( $name ne $states[0] );
  my $state    = $h->{$name};
  my $data     = $state->{data};
  my $comments = $state->{comments};

  # We need to skip over -D arguments, and return if we find --service or
  # [-+]service arguments.  Anything else is probably a capability.
  while( @CMDARGV ) {
    my $arg = shift @CMDARGV;

    if( $arg =~ /^(--service|[-+]service)/i ) {
      unshift @ARGV, $arg;
      return;
    }

    # If we get here, we have a capability to process.  If the $arg
    # starts with '-', we are removing a capabilty, and it isn't
    # necessary to list the '=' or RHS of the capability = RHS.
    #  [-+]?name=value
    # If no leading [-+], assume '+'.
    if( $arg =~ /^-([^=\s]+)/ ) {  # Removing capability
      if( exists( $data->{$1} ) ) {
	if( $1 eq 'protocol' ) {
	  my $sp = "$name:$data->{protocol}";
	  if( $#{$SP{$sp}} == 0 ) {
	    delete( $SP{$sp} );
	  } elsif( $#{$SP{$sp}} > 0 ) {
	    die "Multiple stanzas defined for $sp\n";
	  } else {
	    # Do nothing, didn't exist anyway.
	  }
	}
	delete( $data->{$1} );
      }
    } else {                       # Adding capability
      if( $arg =~ /^\+?([^=\s]+)\s*=\s*(.*)\s*$/ ) {
	$cmd = lc( $1 );
	$data->{$cmd} = $2;
	if( $1 eq 'protocol' ) {
	  my $sp = "$name:$data->{protocol}";
	  $SP{$sp}       = [] unless exists $SP{$sp};
	  push( @{$SP{$sp}}, $h );

	} elsif( $1 eq 'comment' ) {
	  push( @{$comments}, "  # $2" );
	}
      } else {
	die "Capabilities: bad capability ($arg)\n";
      }
    }
  }
}