#!/usr/bin/perl -w

my $debug = 0;

use strict;
use Data::Dumper;
use Text::ParseWords;

#
# Simple line-oriented parser helper routines
#

my $filename;
my $fh;
my $line;
my $lineno;

sub getpos {
  return "$filename:$lineno";
}

sub set {
  $filename = shift;
  $fh = shift;
  $lineno = shift;
  $line = undef;
}

sub curr_line {
  return $line;
}

sub next_line_int {
  $line = <$fh>;
  $lineno++;
  unless (defined($line)) {
    close $fh;
    return;
  }

  while ($line =~ /^[[:space:]]*#/) {
    $line = <$fh>;
    $lineno++;
    return unless defined($line);
  }

  chomp $line;
  $line =~ s/^[[:space:]]*#.*//;
  $line =~ s/[[:space:]]+$//;
}

sub next_line {
  next_line_int();
  while (defined($line) and $line =~ /^$/) {
    next_line_int();
  }
}

sub err {
  my $message = shift;
  die getpos() . ": $message\n";
}

sub e_exp {
  my $expected = shift;
  my $actual = shift;
  $actual = "<EOF>" unless defined($actual);
  err("expected '$expected', got '$actual'");
}

sub open_file {
  my $name = shift;
  die "No name given\n" unless $name;

  open my $fh, "<$name" or die "$name: Unable to open\n";
  return $fh;
}

if (@ARGV != 3) {
  print STDERR "Usage: mkservicedoc output.xml sanewall-script services-data.txt\n";
  exit 1;
}

$fh = open_file($ARGV[1]);

# Extract service information from script
my %services = ();
my %all_run = ();

while (<$fh>) {
  if (/^(server|client)_([[:alnum:]_]+)_ports="?([^"]*)"?/) {
    $services{$2}{$1} = $3;
  }
  if (/^(helper)_([[:alnum:]_]+)="?([^"]*)"?/) {
    my $field = $1;
    my $name = $2;
    my $val = $3;
    $services{$name}{$field} = $val;
    $services{$name}{"mod"} = $val;
    $services{$name}{"mod"} =~ s/([^[:space:]]+)/nf_conntrack_$1/g;
    $services{$name}{"mod"} =~ s/[[:space:]]+/,/g;
    $services{$name}{"modnat"} = $val;
    $services{$name}{"modnat"} =~ s/([^[:space:]]+)/nf_nat_$1/g;
    $services{$name}{"modnat"} =~ s/[[:space:]]+/,/g;
  }
  if (/^rules_([[:alnum:]_]+)\(\) {/) {
    $services{$1}{type} = "complex";
  }
  if (/^ALL_SHOULD_ALSO_RUN="/) {
    s/^[^ ]* //;
    s/"$//;
    for my $s (split(/[[:space:]]+/, $_)) {
      $all_run{$s} = 1;
    }
  }
}
close $fh;

my %single_cmd = (
                  'CPORT' => 'client',
                  'SPORT' => 'server',
                  'MOD' => 'mod',
                  'MODNAT' => 'modnat',
                  'NAME' => 'name',
                  'ALIAS' => 'alias',
                  'WIKI' => 'wiki',
                  'HOME' => 'home',
                 );

my %multi_cmd = (
                  'EXAMPLE' => 'example',
                  'NOTES' => 'notes',
                 );

# Extract service information from database
$filename = $ARGV[2];
$fh = open_file($ARGV[2]);
my %db = ();
my %dbalias = ();
next_line;
while (curr_line()) {
  my $name;
  if ($line =~ /^SERVICE (.*)/) {
    my $name = $1;
    next_line;
    last unless $line;
    while ($line =~ /^\t([[:alnum:]]+)/) {
      my $cmd = $1;
      $line =~ s/^[[:space:]]+[[:alnum:]]+[[:space:]]+//;
      if ($single_cmd{$cmd}) {
        my $n = $single_cmd{$cmd};
        $db{$name}{$n} = $line;
        if ($n eq "alias") {
          $dbalias{$line} = $name;
        }
        next_line;
        last unless $line;
      } elsif ($multi_cmd{$cmd}) {
        my $n = $multi_cmd{$cmd};
        my $val;
        next_line;
        last unless $line;
        while ($line =~ /^\t\t/) {
          $line =~ s/^[[:space:]]+//;
          $line =~ s/^-$//;
          if (defined($val)) { $val .= "\n" . $line } else { $val = $line; }
          next_line;
          last unless $line;
        }
        $db{$name}{$n} = $val if (defined($val));
      } else {
        err "Unknown command $cmd\n";
      }
      last unless $line;
    }
  } else {
    err "Unknown line $line\n";
  }
}
close $fh;

my $err;
my %servs = ();
foreach my $s (sort(keys(%services))) {
  unless ($db{$s} or $dbalias{$s}) {
    print STDERR "Service $s in sanewall but not in services-data.txt\n";
    $err = 1;
  }
  $servs{$s} = 1;
}

foreach my $d (sort(keys(%db))) {
  unless ($services{$d}) {
    print STDERR "Service $d services-data.txt but not in sanewall\n";
    $err = 1;
  }
  $servs{$d} = 1;
}

foreach my $k (sort(keys(%servs))) {
  my $name = $db{$k}{"name"};
  if (!defined($name) and !defined($dbalias{$k})) {
    print STDERR "Service $k has no NAME or ALIAS in services-db.txt\n";
    $err = 1;
  }
  if (defined($db{$k}{"mod"}) and !defined($services{$k}{"mod"})) {
    print STDERR "Service $k has services-db.txt MOD but no helper in script!\n";
    $err = 1;
  }
  if (defined($db{$k}{"modnat"}) and !defined($services{$k}{"modnat"})) {
    print STDERR "Service $k has services-db.txt MODNAT but no helper in script!\n";
    $err = 1;
  }
  if (defined($db{$k}{"mod"}) and defined($services{$k}{"mod"})) {
    if ($db{$k}{"mod"} eq $services{$k}{"mod"}) {
      print STDERR "Service $k MOD in services-db.txt is redundant\n";
      $err = 1;
    } elsif ($db{$k}{"mod"} ne "N/A" and $db{$k}{"mod"} !~ /^See/) {
      print STDERR "Service $k services-db.txt MOD, different to helper in script and not N/A!\n";
      $err = 1;
    }
  }
  if (defined($db{$k}{"modnat"}) and defined($services{$k}{"modnat"})) {
    if ($db{$k}{"modnat"} eq $services{$k}{"modnat"}) {
      print STDERR "Service $k MODNAT in services-db.txt is redundant\n";
      $err = 1;
    } elsif ($db{$k}{"modnat"} ne "N/A" and $db{$k}{"modnat"} !~ /^See/) {
      print STDERR "Service $k services-db.txt MODNAT, different to helper in script and not N/A!\n";
      $err = 1;
    }
  }
}
exit 1 if $err;

sub coalesce {
  while (@_ > 0) {
    $_ = shift @_;
    return $_ if defined $_;
  }
  return undef;
}

sub docmod {
  my $b = "http://cateee.net/lkddb/web-lkddb";
  my $modlist = shift @_;

  my @mods = split(/,/, $modlist);
  my @modwithurl = ();
  foreach my $mod (@mods) {
    if ($mod =~ /^nf/) {
      my $m = uc($mod);
      $m =~ s/CONNTRACK_PROTO/CT_PROTO/;
      push @modwithurl, "$mod (<ulink url=\"$b/$m.html\">CONFIG_$m</ulink>)";
    } else {
      push @modwithurl, $mod;
    }
  }

  $modlist = join(", ", @modwithurl);
  return $modlist;
}

open O, ">$ARGV[0]" or die;

print O '<!DOCTYPE refsect1 PUBLIC "-//OASIS//DTD DocBook XML V4.1.2//EN"' . "\n";
print O '        "http://www.oasis-open.org/docbook/xml/4.5/docbookx.dtd">'."\n";
print O '<!-- For license information see sanewall-manual-info.xml.in -->'."\n";
print O "<refsect1><title>Services</title>\n";
print O "  <para>\n";
print O "    This <ulink url=\"http://en.wikipedia.org/wiki/List_of_TCP_and_UDP_port_numbers\">Wikipedia list of ports</ulink> may be helpful if you need to define a new service.\n";
print O "  </para>\n";
my @keys = sort { return uc($a) cmp uc($b) } keys(%servs);
foreach my $k (@keys) {
  my $name = $db{$k}{"name"};
  my @links = ();
  my $home = $db{$k}{"home"};
  my $wiki = $db{$k}{"wiki"};
  push @links, "<ulink url=\"$home\">Homepage</ulink>" if $home;
  push @links, "<ulink url=\"$wiki\">Wikipedia</ulink>" if $wiki;

  my $sport = coalesce($db{$k}{"server"}, $services{$k}{"server"}, "N/A");
  my $cport = coalesce($db{$k}{"client"}, $services{$k}{"client"}, "N/A");
  my $netmod = coalesce($db{$k}{"mod"}, $services{$k}{"mod"});
  my $natmod = coalesce($db{$k}{"modnat"}, $services{$k}{"modnat"});
  my $example = coalesce($db{$k}{"example"}, $services{$k}{"example"});
  my $notes = coalesce($db{$k}{"notes"}, $services{$k}{"notes"});
  print O "\n";
  if ($dbalias{$k}) {
    my $official = $dbalias{$k};
    $name = $db{$official}{"name"};
  }

  print O "  <variablelist id=\"service-$k\">\n";
  print O "    <title>$k - $name\n";
  print O "      <indexterm>\n";
  print O "        <primary>$k</primary>\n";
  print O "        <secondary>$name</secondary>\n";
  print O "      </indexterm>\n";
  print O "    </title>\n";

  if ($dbalias{$k}) {
    print O "    <varlistentry><term>Alias</term>\n";
    print O "      <listitem>\n";
    print O "        <para>See <xref linkend=\"service-$dbalias{$k}\"/></para>\n";
    print O "      </listitem>\n";
    print O "    </varlistentry>\n";
    print O "  </variablelist>\n";
    next;
  }


  if ($example) {
    print O "    <varlistentry><term>Example</term>\n";
    print O "      <listitem><para>Configuration sample:";
    print O "        <programlisting>$example</programlisting>\n";
    print O "      </para></listitem>\n";
    print O "    </varlistentry>\n";
  }
  print O "    <varlistentry><term>Server Ports</term>\n";
  print O "      <listitem><para>$sport</para></listitem>\n";
  print O "    </varlistentry>\n";
  print O "    <varlistentry><term>Client Ports</term>\n";
  print O "      <listitem><para>$cport</para></listitem>\n";
  print O "    </varlistentry>\n";
  if ($netmod) {
    print O "    <varlistentry><term>Netfilter Modules</term>\n";
    print O "      <listitem><para>" .docmod($netmod). "</para></listitem>\n";
    print O "    </varlistentry>\n";
  }
  if ($natmod) {
    print O "    <varlistentry><term>Netfilter NAT Modules</term>\n";
    print O "      <listitem><para>" .docmod($natmod). "</para></listitem>\n";
    print O "    </varlistentry>\n";
  }
  if (@links) {
    print O "    <varlistentry><term>Links</term>\n";
    print O "      <listitem><para>\n";
    print O "        " . join(", ", @links) . "\n";
    print O "      </para></listitem>\n";
    print O "    </varlistentry>\n";
  }
  if ($k eq "all") {
    my $xtra_notes = "The following complex services are activated:\n";
    $xtra_notes .= "<simplelist>\n";
    foreach my $s (sort(keys(%all_run))) {
      $xtra_notes .= "<member><xref linkend=\"service-$s\"/></member>\n";
    }
    $xtra_notes .= "</simplelist>\n";
    if (defined($notes)) {
      $notes .= "\n" . $xtra_notes;
    } else {
      $notes = $xtra_notes;
    }
  }
  if ($notes) {
    print O "    <varlistentry><term>Notes</term>\n";
    print O "      <listitem>\n";
    print O "        <para>\n";
    $notes =~ s/&/&amp;/g;
    $notes =~ s/&amp;nbsp;/&nbsp;/g;
    my @lines = split /\n/, $notes;
    my @paras = ();
    while (@lines > 0) {
      my $_ = shift @lines;
      if (@paras == 0) {
        push @paras, $_;
      } elsif ($_ eq "") {
        push @paras, "";
      } else {
        if ($paras[$#paras] eq "") {
          $paras[$#paras] = $_;
        } else {
          $paras[$#paras] .= "\n          $_";
        }
      }
    }
    print O "          " .
        join("\n        </para>\n        <para>\n          ", @paras) . "\n";
    print O "        </para>\n";
    print O "      </listitem>\n";
    print O "    </varlistentry>\n";
  }
  print O "  </variablelist>\n";
}
print O "\n</refsect1>\n";

#print STDERR Dumper(\%services) . "\n";
#print STDERR Dumper(\%db) . "\n";
