eval 'exec perl -x $0 ${1+"$@"}' # -*-perl-*-
  if 0;
#!perl -w
#
# ======================================================================
# This file is Copyright 1998 by the Purdue Research Foundation and may
# only be used under license.  For terms of the license, see the file
# named COPYRIGHT included with this software release.
# ======================================================================
#
# makeagent: convert from an agent specification file to agent code.
# Diego Zamboni, May 12, 1998.
#
# !!!!!!!! IMPORTANT !!!!!!!!!!
# Do not edit this file directly. The original, commented source of this
# program is kept in noweb format in makeagent.nw. Please edit that file
# to make any changes, and then "make makeagent.pl" to update the
# executable file. The RCS modification log is also kept in that file.

package makeagent;

use strict;
use Carp;
use Getopt::Long;

use vars qw(
            %FIELDS
            %STDFIELDS
            $continuation
            @ONE_LINE_FIELDS
            @MULTI_LINE_FIELDS
            $action
            %FIELDLINE
            %LINEREF
            $generate_linerefs
           );
  
BEGIN {
  my $varsdecl;
    @ONE_LINE_FIELDS=qw(
                        NAME
                        DESCRIPTION
                        VERSION
                        AUTHOR
                        PERIOD
                        PACKAGES
                       );
    
    @MULTI_LINE_FIELDS=qw(
                          PREAMBLE
                          INIT
                          CHECK
                          CLEANUP
                          COMMAND
                          PARAMS
                          CHANGELOG
                          BUGS
                          TODO
                          SUGGESTIONS
                          FUTURE
                          LONGDESCRIPTION
                          FILTERS
                          RUNTIMEINIT
                         );;
  $varsdecl="use vars qw(";
  foreach (@ONE_LINE_FIELDS) {
    $STDFIELDS{$_}=0;
    $LINEREF{$_}="";
    $varsdecl .= "\$$_ ";
  }
  foreach (@MULTI_LINE_FIELDS) {
    $STDFIELDS{$_}=1;
    $LINEREF{$_}="";
    $varsdecl .= "\$$_ ";
  }
  $varsdecl .= ')';
  $continuation=undef;
  eval $varsdecl;
};
$action="aas-to-pm";
$generate_linerefs=1;
GetOptions("action=s" => \$action, "linerefs!" => \$generate_linerefs);
die "Invalid action: $action\n" 
  unless ($action eq "aas-to-pm" || 
          $action eq "empty-aas");;;
if ($action eq "aas-to-pm") {
  while (<>) {
    my ($line, @line, $keyword, $ukeyword, $flineno);
      chomp;
      $line=$_;
      @line=split(/[:\s]+/, $line);
      $flineno=$.;;
    $keyword=$line[0] || "";
    $ukeyword=$keyword;
    if (exists($STDFIELDS{$ukeyword})) {
      my $result;
      my $subroutine;
      # A keyword automatically cancels any multi-line mode
      undef($continuation);
      # Store the line number on which the keyword was read. Each code-generation
      # subroutine will use this in the appropriate manner.
      $FIELDLINE{$ukeyword}=$flineno;
      # If a subroutine called field_KEY exists, where KEY is the keyword,
      # then call it.
      if (exists $makeagent::{"field_$ukeyword"}) {
        # Call a subroutine called field_KEY, where KEY is the keyword.
        $subroutine="field_$ukeyword";
        $result=eval "$subroutine(\$line, \@line)";
      }
      # If not, call the appropriate generic routine, depending on whether
      # the keyword is single-line or multi-line.
      else {
        if ($STDFIELDS{$ukeyword}==0) {
          # Single line
          $subroutine="field_single_line";
        }
        elsif ($STDFIELDS{$ukeyword}==1) {
          # Multi-line
          $subroutine="field_multi_line";
        }
        else {
          die "Internal error: Weird value for \$STDFIELDS{$ukeyword}: ".
              "$STDFIELDS{$ukeyword}\n";
        }
        $result=eval "$subroutine(\$ukeyword, \$line, \@line)";
      }
      if ($@) {
        die "Error in $subroutine: $@";
      }
      if (!$result) {
        die "Error processing AAS file when calling $subroutine.\n";
      }
      # The subroutine may modify its FIELDLINE value, so now we generate
      # the corresponding text.
      if ($generate_linerefs) {
        $LINEREF{$ukeyword}="# $FIELDLINE{$ukeyword} \"$ARGV\"\n";
      }
      else {
        $LINEREF{$ukeyword}="";
      }
      next;
    };
    if ($continuation) {
      my $ucont=uc($continuation);
      my $result;
      my $subroutine;
      # If cont_$continuation exists, call it.
      if (exists $makeagent::{"cont_$ucont"}) {
        $subroutine="cont_$ucont";
        $result=eval "$subroutine(\$line, \@line)";
      }
      # If not, call cont_multi_line.
      else {
        $subroutine="cont_multi_line";
        $result=eval "$subroutine(\$ucont, \$line, \@line)";
      }
      if ($@) {
        die "Error in $subroutine: $@";
      }
      if (!$result) {
        die "Error processing AAS file when calling $subroutine.\n";
      }
      next;
    };
      if ( ( $line =~ /^\s*\#/ ) || ( $line =~ /^\s*$/ ) ) {
        next;
      };
    die "Invalid input line $.: $line\n";;
  };
  print_code();;
}
elsif ($action eq "empty-aas") {
  foreach (keys %STDFIELDS) {
    $FIELDS{$_}="##--$_--##";
  }
  $FIELDS{COMMAND}={};;
  print_code();;
}
else {
  die "Invalid action specified: $action\n";
}

sub field_single_line {
  my $field=shift;
  my $line=shift;
  # Split the whole line in the field name plus the rest.
  my @sline=split(/[:\s]+/, $line, 2);
  # Check that we have exactly two elements.
  die "Invalid line: $line" unless scalar(@sline)==2;
  # The second element of the array is the data contents of the line.
  # Strip it of surrounding white space.
  $line=$sline[1];
  $line=~s/^\s*//;
  $line=~s/\s*$//;
  # Store it in the appropriate field.
  $FIELDS{$field}=$line;
  return 1;
}
sub field_multi_line {
  my $field=shift;
  my $line=shift;
  # Split the whole line in the field name plus the rest.
  my @sline=split(/[:\s]+/, $line, 2);
  # Check that we have exactly two elements.
  die "Invalid line: $line" unless scalar(@sline)==2;
  # The second element of the array is the data contents of the line.
  # Strip it of surrounding white space.
  $line=$sline[1];
  $line=~s/^\s*//;
  $line=~s/\s*$//;
  # If the line contains any data, store it as the first line of the field.
  # If not, leave it empty.
  if ($line) {
    $FIELDS{$field} .= "$line\n";
  }
  else {
    $FIELDS{$field} .= "";
    # Update the line number, because we are skipping the current one.
    $FIELDLINE{$field}++;
  }
  # Set the continuation variable
  $continuation=$field;
  return 1;
}
sub cont_multi_line {
  my $field=shift;
  my $line=shift;
  $FIELDS{$field} .= "$line\n";
  return 1;
}
sub field_PACKAGES {
  # Split the line using spaces only.
  my $line=shift;
  my @packages=split(/\s+/, $line);
  # Remove the field name
  shift @packages;
  foreach (@packages) {
    if ($generate_linerefs) {
      $FIELDS{PACKAGES} .= "# $FIELDLINE{PACKAGES} \"$ARGV\"\n";
    }
    $FIELDS{PACKAGES} .= "use $_;\n";
  }
  return 1;
}
sub field_PARAMS {
  $continuation="PARAMS";
  # Eliminate the keyword part from the first line, and use it as code.
  my $line=shift;
  my @sline=split(/[:\s]+/, $line, 2);
  # Check that we have exactly two elements.
  die "Invalid line: $line" unless scalar(@sline)==2;
  # The second element of the array is the data contents of the line.
  # Strip it of surrounding white space and commas at the end.
  $line=$sline[1];
  $line=~s/^\s*//;
  $line=~s/[,\s]*$//;
  if ($line) {
    $FIELDS{PARAMS} .= " " x 13 . "$line,\n";
  }
  else {
    $FIELDS{PARAMS} = "";
    # Increase the line number because we are skipping the current one.
    $FIELDLINE{PARAMS}++;
  }
  return 1;
}
sub cont_PARAMS {
  my $line=shift;
  $line =~ s/^\s+//;
  $line =~ s/[,\s]+$//;
  if ($line) {
    $FIELDS{PARAMS} .= " " x 13 . "$line,\n";
  }
  return 1;
}
sub field_COMMAND {
  my $line=shift;
  if ($line =~ /^command\s+(\w+)\s*\(([^\)]*)\)\s*:?\s*$/i) {
    my $cmdname=uc($1);
    my $args=$2;
    # This is a dirty hack. %args ends up containing one entry for each
    # argument, with the element containing the '?' or nothing, depending
    # on whether it was given or not. This allows easy testing of which
    # arguments are optional and which not. For example, if $args
    # contains "bla, ble?, bli?, blo", then %args contains:
    # %a = (
    #   'bla' => ''
    #   'ble' => '?'
    #   'bli' => '?'
    #   'blo' => ''
    # )

    my %args=($args =~ /(\w+)\s*(\??)(?:[,\s]+)?/g);
    if (!defined($FIELDS{COMMAND})) {
      $FIELDS{COMMAND}={}
    }
    # Store current command
    $FIELDS{COMMAND}->{__Current}=$cmdname;
    # Check that the command does not exist.
    if (exists $FIELDS{COMMAND}->{$cmdname}) {
      die "Redefined command: $cmdname\n";
    }
    # Create entry for the command being defined
    $FIELDS{COMMAND}->{$cmdname}={};
    # Store the appopriate info there
    $FIELDS{COMMAND}->{$cmdname}->{ObArgs}=[];
    $FIELDS{COMMAND}->{$cmdname}->{OptArgs}=[];
    $FIELDLINE{COMMAND}++;
    if ($generate_linerefs) {
      $FIELDS{COMMAND}->{$cmdname}->{Code}="# $FIELDLINE{COMMAND} \"$ARGV\"\n";
    }
    else {
      $FIELDS{COMMAND}->{$cmdname}->{Code}="";
    }
    foreach (keys %args) {
      if ($args{$_}) {
        push @{$FIELDS{COMMAND}->{$cmdname}->{OptArgs}}, $_;
      }
      else {
        push @{$FIELDS{COMMAND}->{$cmdname}->{ObArgs}}, $_;
      }
    }
    # Set continuation flag and return.
    $continuation="COMMAND";
    return 1;
  }
  else {
    die "Invalid line: $line";
  }
}
sub cont_COMMAND {
  my $cmd=$FIELDS{COMMAND}->{__Current};
  if ($cmd) {
    $FIELDS{COMMAND}->{$cmd}->{Code} .= $_[0] . "\n";
    return 1;
  }
  else {
    die "Current command not set.";
  }
}
sub print_code {
  # Associate a handle with STDOUT, so that we can redirect it later without
  # much problems.
  open(CODE, ">&STDOUT") or die "Could not open code output handle: $!";
  # Put some of the fields in simpler variables for easy referencing.
  foreach (keys %STDFIELDS) {
    no strict 'refs';
    $ {$_} = $FIELDS{$_} || "";
    #  $ {$_} =~ s/^\s+//;
    $ {$_} =~ s/\s+$//;
  }
  my $TODAY=scalar(localtime);
  my $EMPTY="";
  my $COPY;
  my $STARTLINE;

  # Provide defaults for some of the fields.
  $PERIOD="undef" if !$PERIOD;

  # Line to load perl
  $STARTLINE=q(eval 'exec perl -x $0 ${1+"$@"}' # -*-perl-*-
  if 0;
#!perl -w);

  # Insert the copyright notice only if we are in a CERIAS machine.
  if (-d "/u/coast4/aafid/AAFID2" or -d "/usr/ceriaslocal" ) {
    $COPY="#
# ======================================================================
# This file is Copyright 1998,1999 by the Purdue Research Foundation and
# may only be used under license.  For terms of the license, see the
# file named COPYRIGHT included with this software release.
# AAFID is a trademark of the Purdue Research Foundation.
# All rights reserved.
# ======================================================================
#";
  }
  else {
    $COPY="#";
  }
  print CODE <<__EOCODE__;
$STARTLINE
$COPY
# AAFID2 system
# Agent name:        $NAME
# Agent description: $DESCRIPTION
# Author:            $AUTHOR
#
__EOCODE__

  print_commented_if_exists($CHANGELOG, "History of modifications");
  print_commented_if_exists($BUGS, "Known bugs");
  print_commented_if_exists($TODO, "Things to do");
  print_commented_if_exists($FUTURE, "Future work");
  print_commented_if_exists($SUGGESTIONS, "Suggestions made by people");

  print CODE <<__EOCODE__;
# Generated automatically by $0 on $TODAY.
# 
###### AUTOMATICALLY GENERATED FILE --- DO NOT EDIT ##########
#

$LINEREF{NAME}package $NAME;

# Version number
$LINEREF{VERSION}\$VERSION=eval {$VERSION}; \$VERSION=\$VERSION;

# Agent parameters
%PARAMETERS=(
             Description        => "$DESCRIPTION",
             CheckPeriod        => eval {$PERIOD},
$LINEREF{PARAMS}$PARAMS
$LINEREF{FILTERS}             FiltersNeeded => { $FILTERS }
            );

# Package loading
use AAFID::Agent;
use AAFID::Log;
use AAFID::Common;
$PACKAGES

use vars qw (
             \@ISA
             \$VERSION
             %PARAMETERS
            );

# Define the superclass.
 \@ISA=qw(AAFID::Agent);
$EMPTY
=head1 $NAME

$LONGDESCRIPTION
$EMPTY
=cut

# Preamble code
$LINEREF{PREAMBLE}$PREAMBLE
__EOCODE__

print_if_not_empty($INIT, "
# Provide an Init function.
sub Init {
  my \$self=checkref(shift);
$LINEREF{INIT}$INIT
  return \$self;
}
");

print_if_not_empty($RUNTIMEINIT, "
# The runtime initialization function.
sub runtimeInit {
  my \$self=checkref(shift);
$LINEREF{RUNTIMEINIT}$RUNTIMEINIT
  return \$self;
}
");

print_if_not_empty($CHECK, "
# The Check function.
sub Check {
  my \$self=checkref(shift);
$LINEREF{CHECK}$CHECK
}
");

print_if_not_empty($CLEANUP, "# The Cleanup function
sub Cleanup {
  my \$self=checkref(shift);
  my \$reason=shift;
$LINEREF{CLEANUP}$CLEANUP
}
");

  print CODE <<__EOCODE__;
# Agent commands
__EOCODE__

  my $cmd;
  if ($action eq "aas-to-pm") {
    foreach $cmd (keys %{$FIELDS{COMMAND}}) {
      next if $cmd eq '__Current';
      my $assigncode="";
      my $checkcode="";
      foreach (@{$FIELDS{COMMAND}->{$cmd}->{ObArgs}}, 
               @{$FIELDS{COMMAND}->{$cmd}->{OptArgs}}) {
        $assigncode .= "my \$$_ = \$p{$_};\n";
      }
      foreach (@{$FIELDS{COMMAND}->{$cmd}->{ObArgs}}) {
        $checkcode .= "exists(\$p{$_}) && ";
      }
      $checkcode .= "1";
      my $cmdcode=$FIELDS{COMMAND}->{$cmd}->{Code};
      $cmdcode=~s/\s+$//;
      $checkcode=~s/\s+$//;
      $assigncode=~s/\s+$//;
      print CODE <<__EOCODE__;

sub command_$cmd {
  my \$self=checkref(shift);
  my (\$message, %p)=\@_;
  if ($checkcode) {
    $assigncode
$cmdcode
    # By default, return undef
    return undef;
  }
}
__EOCODE__
    }
  }
  elsif ($action eq "empty-aas") {
    print CODE "##--COMMANDS--##";
  }
  else {
    die "Internal error: Weird action value: $action\n";
  }
  
  # Finally, emit the end-of-file.
  print CODE "\n# End of entity marker\n";
  print CODE "_EndOfEntity;\n";
}
sub print_commented_if_exists {
  my $string=shift;
  my $description=shift;
  $string=~s/^/# /gm if $string;
  print CODE "# $description:\n" if $description;
  print CODE "$string\n" if $string;
  print CODE "# \n";
}
sub print_if_not_empty {
  my $t=shift;
  my $string=shift;
  print CODE $string if $t;
};

__END__

=head1 NAME

makeagent -- convert an AAFID agent specification file to agent code.

=head1 SYNOPSIS

makeagent [--action=<action>] [--linerefs | --nolinerefs ] [file.aas]

=head1 DESCRIPTION

C<makeagent> allows the manipulation of AAFID Agent Specification (AAS)
files including:

=over 4

=item *

Generating Perl code for an AAFID Agent from an AAS file.

=item *

Generation of an "empty" AAFID Agent which can be used as a template,
with placeholders where specific agent information needs to be inserted.

=back 4

If given the C<--action=aas-to-pm> flag (this is also the default behavior
if no options are given), the input (either specified by a filename or
from standard input) is expected to be in AAS format, and the Perl code
necessary for implementing the corresponding agent is printed to
standard output.

If the C<--action==empty-aas> option is given, the Perl code generated
contains strings of the form C<##--FIELD--##> in the places where the
value of each field would be inserted. The generated code does not
compile or run, and is intended only for use for testing and debugging
purposes, or for the generation of a template.

If the C<--linerefs> option is given (it is on by default), then "#" lines
are generated in the Perl code that make reference to the corresponding
lines in the .aas file (this only works if a file name is given as
argument instead of reading from standard input). These lines have
the following format:
 
   # linenumber "file.aas"

and their effect is that if an error occurs, the error message produced
by Perl makes reference to the correct line in the .aas file and not
to some obscure line in the middle of machine-generated Perl code.
This behavior is enabled by default, and can be suppressed by using the
C<--nolinerefs> option.

The AAS file contains field/value pairs. Some fields have single-line values,
and other have multi-line values. For single-line fields, the value must
be in the same line as the field name, separated by a colon. In multi-line
fields, the value may start in the same line as the field name (separated
by a colon), but it may continue in the following lines, until the next
field specification. In multi-line fields whose values are code (such
as CHECK, INIT, PREAMBLE and COMMAND), the indentation is preserved, and
the code is included as-is in the agent. 

The following are the valid fields. Please note that the field labels
are case sensitive. They have to be all uppercase to be recognized as
labels.

  NAME: <agent name> (single line)

  DESCRIPTION: <agent description> (single line)

  VERSION: <version> (single line, usually of the form X.Y)

  AUTHOR: <author name> (single line)

  PERIOD: <check period, in seconds> (single line, numeric)

  PACKAGES: pkg1 pkg2 ... (packages to include)

  FILTERS:
     <specification of filters that this agent needs, and the initial
      pattern to be sent to each filter. This information is given
      as a list of the form C<FilterName =E<gt> { Pattern }>, where
      C<Pattern> is itself a list of C<Field =E<gt> "regex"> 
      specifications. For example, if the agent needs the 
      NetworkAccess filter, it only needs the records corresponding to
      telnet accesses from the .cs.purdue.edu domain, and it also
      needs the Shutdowns filter, from which it only needs the records
      corresponding to reboots, the FILTERS specification may look
      like this:>

      NetworkAccess => { Daemon => 'telnet', 
                         From => '\.cs\.purdue\.edu$' },
      Shutdowns     => { Type => 'reboot' }
      

  PREAMBLE:
     <code to be included before the subroutine definitions. Should
      normally be only declarations, not executable code.> (multi line)

  INIT:
     <code to be included in the Init subroutine. In here, the %Params
      hash is bound to the agent parameters, which can be read and set
      through it.> (multi line)

  RUNTIMEINIT:
     <code to be included in the runtimeInit subroutine. In here, the 
      %Params hash is bound to the agent parameters, which can be read
      and set through it.> (multi line)

  CHECK:
     <code to be included in the Check routine. In here, the %Params hash
      is bound to the agent parameters, and can be read and set 
      through it.> (multi line)

  CLEANUP:
     <code to be included in the Cleanup subroutine, which gets executed
      when the agent stops executing. In here, the %Params hash is bound
      to the agent parameters, which can be read and set through it. Also,
      the $reason variable contains a string with the reason for stopping
      the execution.> (multi line)

  COMMAND cmdname(Arg1[, Arg2 ...]):
     <defines a new command named CMDNAME. Inside the body, the named
      arguments are bound to variables $Arg1, $Arg2, etc. If an argument
      name is followed by a question mark, it is optional. Otherwise,
      automatic checks are made to ensure that it is defined.> (multi line)

   PARAMS:
      Parameter => Value
      [ Parameter => Value ]
      [ ... ]
      Adds all the parameter/value pairs specified, exactly as typed,
      to the agent's initial C<%PARAMETERS> hash, as agent-specific 
      parameters (multi line).

   CHANGELOG:
      <History of modifications. If using RCS, you can use the Log
       keyword here.> (multi line)

   BUGS:
      <List of known bugs.> (multi line)

   TODO:
      <List of things to do. Usually maintained by the author.> (multi line)

   SUGGESTIONS:
      <List of suggestions of improvements. Usually made by other people.>
      (multi line)

   LONGDESCRIPTION:
      <Arbitrary text that will be included in a POD section in the
       generated code.>

   FUTURE:
      <Future work. The difference between this and TODO may not be very
       well defined. I think of TODO as near-term specific issues, and
       FUTURE as longer-term, probably more generic plans.> (multi line)

The Perl code is sent to standard output.

=head1 ABOUT CODE FIELDS

In the fields that contain code to be included in a subroutine (INIT, CHECK, 
CLEANUP and COMMAND), it can be assumed that the C<$self> variable will
have been already set to point to the object in which the method is
being called, and in the process, the first argument to the method has
been removed. Additionally, the C<%Params> hash can be used to access
the agent parameters. Finally, in commands, each argument provided is
used to define a variable with that same name, and the variable C<$message>
contains the Message object that requested the command.

=head1 NOTES

The field labels are case sensitive, and they have to be all uppercase to
be recognized as labels.

It is responsibility of the agent writer to ensure the validity 
and correctness of the code and all other field values. 
C<Makeagent> does not do any kind of validation. Make sure you
C<perl -cw> the resulting .pm file before trying to executing it!

Multi-line fields are accumulative.
This means that if the same field occurs multiple times, the texts of all
the occurrences are concatenated into a single value. This may allow, for
example, to distribute the LONGDESCRIPTION portions so that each one
of them is close to the field to which it corresponds.

If the C<--action=empty-aas> flag is given, a "template" agent is produced,
with special values of the form C<##--FIELDNAME--##> instead of the
field values. This is useful primarily for debugging.

=head1 SEE ALSO

perlpod(1).

=head1 AUTHOR

Diego Zamboni (C<zamboni@cs.purdue.edu>).

