#!/usr/bin/perl

my $phsize  = "defs.ph";
my $h2pm    = "./install/h2pm.pl";
my $package = "Packet::Definitions";
my $version = '0.01';
my @paths   = ("/usr/local/include", "/usr/include", ".");

my %revsize = (
 8	=> "q",
 4	=> "i",
 2	=> "s",
 1	=> "a",
);

use Config;

die unless @ARGV;
my $output = shift;
my @hdrs = @ARGV;
my @headers;
foreach (@hdrs) { push(@headers, $_) if -e $_ }

# create original sizeof hash
my %sizeof;
$sizeof{"*"} = 4;
my $sizeof = "my %sizeof = (\n";
for (keys(%Config)) {
 my $orig = $_;
 if (s/size// && !/^d_|type/) {
  $sizeof .= "\t\"$_\"\t=> " . $Config{$orig} . ",\n";
  $sizeof{$_} = $Config{$orig};
  if (s/^uint(.*\d.*)$/__uint$1/) {
   $sizeof .= "\t\"${_}_t\"\t=> " . $Config{$orig} . ",\n";
   $sizeof{$_ . "_t"} = $Config{$orig};
   $sizeof .= "\t\"$_\"\t=> " . $Config{$orig} . ",\n";
   $sizeof{$_} = $Config{$orig};
  }
  elsif (s/^u(.*\d.*)$/__uint$1/) {
   $sizeof .= "\t\"${_}_t\"\t=> " . $Config{$orig} . ",\n";
   $sizeof{$_ . "_t"} = $Config{$orig};
   $sizeof .= "\t\"$_\"\t=> " . $Config{$orig} . ",\n";
   $sizeof{$_} = $Config{$orig};
  }
  elsif (s/^i(.*\d.*)$/int$1/) {
   $sizeof .= "\t\"${_}_t\"\t=> " . $Config{$orig} . ",\n";
   $sizeof{$_ . "_t"} = $Config{$orig};
   $sizeof .= "\t\"$_\"\t=> " . $Config{$orig} . ",\n";
   $sizeof{$_} = $Config{$orig};
  }
 }
}
$sizeof .= "\t\"*\"\t=> 4\n);\n";

my %files;
my %orig;
my %defines;
my %unions;
my %aliases;

########################################################
# the wannabe-C preprocessor
#
sub cpp {
 my $h = shift;
 foreach (@paths) {
  if (-e "$_/$h") {
   open(TYPES, "<$_/$h");
   $files{$h} = $orig{$h} = join("", <TYPES>);
   close(TYPES);
   last;
  }
 }

 # initial processing
 $files{$h} =~ s:/\*.*?\*/: :gs;
 $files{$h} =~ s'\?\?\('['gs;
 $files{$h} =~ s'\?\?\)']'gs;
 $files{$h} =~ s'\?\?<'{'gs;
 $files{$h} =~ s'\?\?>'}'gs;
 $files{$h} =~ s'\?\?='#'gs;
 $files{$h} =~ s'\?\?/'\\'gs;
 $files{$h} =~ s'\?\?\''^'gs;
 $files{$h} =~ s'\?\?!'|'gs;
 $files{$h} =~ s'\?\?-'~'gs;
 $files{$h} =~ s/\\ ?\n//gs;
 $files{$h} =~ s/\/\/[^\n]+\n//gs;
 $files{$h} =~ s'<%'{'gs;
 $files{$h} =~ s'%>'}'gs;
 $files{$h} =~ s'<%'{'gs;
 $files{$h} =~ s'<:'['gs;
 $files{$h} =~ s':>']'gs;
 $files{$h} =~ s'%:'#'gs;
 $files{$h} =~ s'%:%:'##'gs;

 $files{$h} =~ s/#\s*include\s*<([^>]+)>\s*\n/&cpp($1)/egi;
 $files{$h} =~ s/#\s*include\s*"([^>]+)"\s*\n/&cpp($1)/egi; # really shouldn't be happening..
 $files{$h} =~ s/0x([a-f0-9]+)/hex($1)/egi;
 $files{$h} =~ s/(^|\n)\s*/$1/gs;
 $files{$h} =~ s/(^|\n)#\s*/$1#/gs;

 while ($files{$h} =~ s/^#\s*define\s+(\w+(?:\(\))?)(?:\s+([^\n]+))?\n//m) {
  $defines{$1} = $2;
 }
 
 while ($files{$h} =~ s/^#\s*define\s+(\w+)\(([^)]+)\)\s+([^\n]*)\n//m) {
  my ($a, $b, $c) = ($1, $2, $3);
  $b =~ s/\s//g;
  my @f = split(/,/, $b);
  while ($files{$h} =~ /$a\(([^)]+)\)/g) {
   my $d = $1;
   $d =~ s/\s//g;
   my @d = split(/,/, $d);
   my $e = $c;
   for (my $i = 0; $i < @f; $i++) {
    $e =~ s/$f[$i]/$d[$i]/g;
   }
   $files{$h} =~ s/$a\([^)]+\)/$e/;
  }
 }

 foreach (keys(%defines)) {
  if ($defines{$defines{$_}}) {
   $defines{$_} = $defines{$defines{$_}};  
  }
  $files{$h} =~ s/$_/$defines{$_}/gs;
 }
  
 return $files{$h};
}


########################################################
# read in files
#
foreach my $h (@headers) {
# &cpp($h);
 foreach (@paths) {
  if (-e "$_/$h") {
   open(TYPES, "<$_/$h");
   $files{$h} = $orig{$h} = join("", <TYPES>);
   close(TYPES);
   last;
  }
 }
 $files{$h} =~ s/0x([a-f0-9]+)/hex($1)/egi;
 $files{$h} =~ s:/\*.*?\*/: :gs;
}

########################################################
# let's take care of defs -- not a good way, will be
# changed with the c preprocessor function
#
foreach my $h (@headers) {
 while ($files{$h} =~ s/#define\s+(\S+)\s+(0x[a-f0-9]+|\d+)\s*$//ig) {
  $defines{$1} = $2;
  $defines{$1} =~ s/^0x(.*)$/hex($1)/e;
 }
}
foreach my $h (@headers) {
 foreach (keys(%defines)) {
  $files{$h} =~ s/$_/$defines{$_}/g;
 }
}

foreach my $h (@headers) {
 $files{$h} =~ s/(\s)unsigned\s/$1/gs;
 while ($files{$h} =~ s/union\s*{\s*(\S[^}]+\S)\s*}\s*(\S+)\s*;/union $2;/s) {
  $unions{$2} = $1;
 }
 $files{$h} =~ s/union\s+;//gs;

 while ($files{$h} =~ /typedef\s+(.*?)\s+(\S+)\s*;/gs) {
  my ($a, $b) = ($1, $2);
  $sizeof .= "\$sizeof{\"$b\"}\t= \$sizeof{\"$a\"} unless \$sizeof{\"$b\"};\n";
  $sizeof{$b} = $sizeof{$a} unless $sizeof{$b};
  if ($a =~ s/^uint(.*)$/__uint$1/ && $sizeof{$a}) {
   $sizeof .= "\$sizeof{\"$b\"}\t= \$sizeof{\"$a\"} unless \$sizeof{\"$b\"};\n";
   $sizeof{$b} = $sizeof{$a} unless $sizeof{$b};
  }
  elsif ($a =~ s/^u(.*)$/__uint$1/ && $sizeof{$a}) {
   $sizeof .= "\$sizeof{\"$b\"}\t= \$sizeof{\"$a\"} unless \$sizeof{\"$b\"};\n";
   $sizeof{$b} = $sizeof{$a} unless $sizeof{$b};
  }
 }

 while ($files{$h} =~ /TAILQ_HEAD\(\s*(\S+)\s*,\s*(\S+)\s*\)/gs) {
  $aliases{$1} = $2;
 }
}

foreach my $h (@headers) {
 while ($files{$h} =~ s/#define\s+(\S+)\s+(0x)?([\w()]+)//gs) {
  my ($a, $b, $c) = ($1, $2, $3);
  if ($b) { $c = hex($c) }
#  while ($c =~ /(\w+)/gs) {
  if ($c =~ /(\w+)/) {
   my $tmp = $1;
   if ($defines{$tmp}) {
    $c =~ s/$tmp/$defines{$tmp}/gs;
   }
   else {
    $c = "___C_$tmp";
   }
  }
  while ($c =~ /sizeof\((?:struct\s+)?([^)]+)\)/gs) {
   my $tmp = $1;
   if ($sizeof{$tmp}) {
    $c =~ s/sizeof\($tmp\)/$sizeof{$tmp}/gs;
   }
   else {
    $c =~ s/sizeof\($tmp\)/\$sizeof{$tmp}/gs;
   }
  }
  if ($c =~ /\w/) { $c = $defines{$c} if $defines{$c} }
  $defines{$a} = eval($c) unless ($c =~ /\$/ || (($c =~ tr/(//) != ($c =~ tr/)//)) || $c =~ /\)\d/);
 }
}

foreach (keys(%defines)) {
 $defines{$_} =~ /^___C_(.*)$/;
 my $tmp = $1;
 if ($tmp =~ /^\d+$/) {
  $defines{$_} = $tmp;
 }
 else {
  $defines{$_} =~ s/^___C_(.*)$/$defines{$1}/;
 }
}  

my %structs;
my %structfuncs;
my $structsleft;
foreach my $h (@headers) {
 while ($files{$h} =~ /struct\s+(\S+)\s*{\s*([^\s{]*[^{]*?[^\s{]*)\s*};/gs) {
  $structsleft++;
  my ($tmp, @tmp) = ($1, split(/\s*;\s*/, $2));
  my ($func, $pack, $unpack, $packo, $unpacko);
  my $num = my $anum = 0;
  foreach (@tmp) {
   $anum++;
   # create structs hash for creating %sizeof data for structs
   my @spl = split(/\s+/);
   push(@{$structs{$tmp}}, [@spl]);
   if ($spl[0] eq "struct") {
    my $test = $spl[2];
    $test =~ s/\*//;
    push(@{$structinfo{$tmp}}, "\"$test\"");
    $structsleft++;
   }
   else {
    my $test = $spl[1];
    $test =~ s/\*//;
    push(@{$structinfo{$tmp}}, "\"$test\"");
   }

   # create structfuncs hash for creating functions of structs
   my ($times) = ($spl[1] =~ /\[([^\]]+)\]/);
   if ($times && $times =~ /[a-z]/i) {
    if ($defines{$times}) {
     $times = $defines{$times};
    }
    else {
     $times = "\" . &$times . \"";
    }
   }
   else {
    $times = eval($times);
   }

   if ($spl[0] eq "struct") {
    if ($spl[2] =~ /\*/) {
     $pack .= "a$Config{ptrsize}";
    }
    else {
     $pack .= "a\$sizeof{$spl[1]}";
    }
    push(@{$structvals{$tmp}}, "&$spl[1](\$tmp{\"$spl[2]\"})");
    if ($unpacko) {
     $unpack .= "\", substr(\$tmp, 0, $num, \"\")),
    &unp_$spl[1](substr(\$tmp, 0, \$sizeof{\"$spl[1]\"}, \"\"))";
     $unpacko = 0;
    }
    else {
     $unpack .= ",
    &unp_$spl[1](substr(\$tmp, 0, \$sizeof{\"$spl[1]\"}, \"\"))";
    }
   }
   elsif ($spl[0] eq "char") {
    $pack .= "a$times";
    my $tst = $spl[1];
    $tst =~ s/\[[^\]]+\]//;
    push(@{$structvals{$tmp}}, "\$tmp{\"$tst\"}");
    if ($unpacko) {
     $num += ($times || 1);
     $unpack .= "a$times";
    }
    else {
     $num = ($times || 1);
     $unpack .= ", unpack(\"a$times";
     $unpacko = 1;
    }
   }
   elsif ($spl[0] =~ /long/) {
    $pack .= ($spl[0] =~ /^u/ ? "L" : "l") . $times;
    my $tst = $spl[1];
    $tst =~ s/\[[^\]]+\]//;
    push(@{$structvals{$tmp}}, "\$tmp{\"$tst\"}");
    if ($unpacko) {
     $num += $Config{longsize} * ($times || 1);
     $unpack .= ($spl[0] =~ /^u/ ? "L" : "l") . $times;
    }
    else {
     $num = $Config{longsize} * ($times || 1);
     $unpack .= ", unpack(\"" . ($spl[0] =~ /^u/ ? "L" : "l") . $times;
     $unpacko = 1;
    }
   }
   elsif ($spl[0] =~ /int|i\d|ptr/ || $spl[1] =~ /\*/) {
    $pack .= ($spl[0] =~ /^u/ ? "I" : "i") . $times;
    my $tst = $spl[1];
    $tst =~ s/\[[^\]]+\]//;
    push(@{$structvals{$tmp}}, "\$tmp{\"$tst\"}");
    if ($unpacko) {
     $num += $Config{intsize} * ($times || 1);
     $unpack .= ($spl[0] =~ /^u/ ? "I" : "i") . $times;
    }
    else {
     $num = $Config{intsize} * ($times || 1);
     $unpack .= ", unpack(\"" . ($spl[0] =~ /^u/ ? "I" : "i") . $times;
     $unpacko = 1;
    }
   }
   elsif ($spl[0] =~ /short/) {
    $pack .= ($spl[0] =~ /^u/ ? "S" : "s") . $times;
    my $tst = $spl[1];
    $tst =~ s/\[[^\]]+\]//;
    push(@{$structvals{$tmp}}, "\$tmp{\"$tst\"}");
    if ($unpacko) {
     $num += $Config{shortsize} * ($times || 1);
     $unpack .= ($spl[0] =~ /^u/ ? "S" : "s") . $times;
    }
    else {
     $num = $Config{shortsize} * ($times || 1);
     $unpack .= ", unpack(\"" . ($spl[0] =~ /^u/ ? "S" : "s") . $times;
     $unpacko = 1;
    }
   }
   elsif ($spl[0] =~ /quad/) {
    $pack .= ($spl[0] =~ /^u/ ? "Q" : "q") . $times;
    my $tst = $spl[1];
    $tst =~ s/\[[^\]]+\]//;
    push(@{$structvals{$tmp}}, "\$tmp{\"$tst\"}");
    if ($unpacko) {
     $num += 8 * ($times || 1);
     $unpack .= ($spl[0] =~ /^u/ ? "Q" : "q") . $times;
    }
    else {
     $num = 8 * ($times || 1);
     $unpack .= ", unpack(\"" . ($spl[0] =~ /^u/ ? "Q" : "q") . $times;
     $unpacko = 1;
    }
   }
   elsif ($spl[0] =~ /float/) {
    $pack .= "f$times";
    my $tst = $spl[1];
    $tst =~ s/\[[^\]]+\]//;
    push(@{$structvals{$tmp}}, "\$tmp{\"$tst\"}");
    if ($unpacko) {
     $num += 4 * ($times || 1);
     $unpack .= "f$times";
    }
    else {
     $num = 4 * ($times || 1);
     $unpack .= ", unpack(\"f$times";
     $unpacko = 1;
    }
   }
   else {
    $pack .= ($spl[0] =~ /^u/ ? ($revsize{$sizeof{$spl[0]}} eq "a" ? "a"
                              : uc($revsize{$sizeof{$spl[0]}})) : $revsize{$sizeof{$spl[0]}}) . $times;
    my $tst = $spl[1];
    $tst =~ s/\[[^\]]+\]//;
    push(@{$structvals{$tmp}}, "\$tmp{\"$tst\"}");
    if ($unpacko) {
     $num += ($times || 1);
     $unpack .= ($spl[0] =~ /^u/ ? ($revsize{$sizeof{$spl[0]}} eq "a" ? "a"
                                 : uc($revsize{$sizeof{$spl[0]}})) : $revsize{$sizeof{$spl[0]}}) . $times;
    }
    else {
     $num = ($times || 1);
     $unpack .= ", unpack(\"" . ($spl[0] =~ /^u/ ? ($revsize{$sizeof{$spl[0]}} eq "a" ? "a"
                : uc($revsize{$sizeof{$spl[0]}})) : $revsize{$sizeof{$spl[0]}}) . $times;
     $unpacko = 1;
    }
   }
  }
  if ($anum == 0) { $sizeof{$tmp} = 0 }
  if ($unpacko) {
   $unpack .= "\", substr(\$tmp, 0, $num, \"\"))";
  }
  $unpack =~ s/^,\s+//;
  $structunpack{$tmp} = $unpack;
  $structfuncs{$tmp} = $pack;
 }
}

while ($structsleft > 0) {
 foreach my $st (keys(%structs)) {
  next if $sizeof{$st};
  my ($sts, $nsize, $size);
  foreach my $h (@{$structs{$st}}) {
   if ($$h[0] eq "struct" && !defined $sizeof{$$h[1]} && !defined $sizeof{$aliases{$$h[1]}}) {
    if ($$h[2] =~ /^\*/) {
     $size += $Config{ptrsize};
     $structsleft--;
    }
    else {
     $sts++;
     last;
    }
   }
   elsif ($$h[0] eq "union") {
    if (defined $sizeof{$$h[1]}) {
     $size += $sizeof{$$h[1]};
    }
    else {
     my $top = 4;
     my $stss;
     foreach my $u (split(/;/, $unions{$$h[1]})) {
      $u =~ s/^\s*//;
      $u =~ s/\s*$//;
      my @vals = split(/\s+/, $u);
      if ($vals[0] eq "struct" && !defined $sizeof{$vals[1]}) {
       if ($vals[2] =~ /^\*/) {
        $top = $Config{ptrsize} unless $top > $Config{ptrsize};
       }
       else {
        $stss++;
        last;
       }
      }
      elsif ($vals[0] eq "struct") {
       $top = $sizeof{$vals[1]} if $sizeof{$vals[1]} > $top;
      }
      else {
       if ($vals[1] =~ s/\[([^a-z]+)\]//i) {
        my $temp = (eval($1) * $sizeof{$vals[0]}) || (eval($1) * $sizeof{$vals[1]});
        $top = $temp if $temp > $top;
       }
       elsif ($vals[1] =~ s/\[([^\]]+)]//) {
        if ($defines{$1}) {
         my $temp = ($defines{$1} * $sizeof{$vals[0]}) || ($defines{$1} * $sizeof{$vals[1]});
         $top = $temp if $temp > $top;
        }
        else {
         $stss++;
         last;
        }
       }
       else {
        my $temp = ($sizeof{$$h[0]} || $sizeof{$$h[1]});
        $top = $temp if $temp > $top;
       }
      }
     }
     unless ($stss) {
      $sizeof{$$h[1]} = $top;
      $size += $top;
     }
    }
   }
   else {
    if ($$h[1] =~ s/\[([^a-z]+)\]//i) {
     $size += (eval($1) * $sizeof{$$h[0]}) || (eval($1) * $sizeof{$$h[1]}) || (eval($1) * $sizeof{$aliases{$$h[0]}}) || (eval($1) * $sizeof{$aliases{$$h[1]}});
     if ((!$sizeof{$$h[0]} && $sizeof{$$h[1]}) || (!$sizeof{$alises{$$h[0]}} && $sizeof{$aliases{$$h[1]}})) {
      $structsleft--;
     }
    }
    elsif ($$h[1] =~ s/\[([^\]]+)]//) {
     if ($defines{$1}) {
      $size += ($defines{$1} * $sizeof{$$h[0]}) || ($defines{$1} * $sizeof{$$h[1]})
            || ($defines{$1} * $sizeof{$aliases{$$h[0]}}) || ($defines{$1} * $sizeof{$aliases{$$h[1]}});
     }
     else {
      $nsize .= " + (&$1 * " . ($sizeof{$$h[0]} || $sizeof{$$h[1]} || $sizeof{$aliases{$$h[0]}} || $sizeof{$alises{$$h[1]}}) . ")";
     }
     if ((!$sizeof{$$h[0]} && $sizeof{$$h[1]}) || (!$sizeof{$alises{$$h[0]}} && $sizeof{$alises{$$h[1]}})) {
      $structsleft--;
     }
    }
    else {
     $size += $sizeof{$$h[0]} || $sizeof{$$h[1]} || $sizeof{$aliases{$$h[0]}} || $sizeof{$aliases{$$h[1]}};
     if ((!$sizeof{$$h[0]} && $sizeof{$$h[1]}) || (!$sizeof{$alises{$$h[0]}} && $sizeof{$alises{$$h[1]}})) {
      $structsleft--;
     }
    }
   }
  }
  unless ($sts) {
   $sizeof{$st} = $size;
   $sizeof .= "\$sizeof{\"$st\"}\t= $size$nsize;\n";
   $structsleft--;
  }
 }
}

my @ph;
foreach (keys(%orig)) {
 open(H2PM, ">$phsize");
 print H2PM $orig{$_};
 close(H2PM);
 open(PH, "$h2pm < $phsize|");
 push(@ph, join("", <PH>));
 close(PH);
 unlink($phsize);
 if (/sysctl/) {
  $ph[-1] =~ s/struct //gs;
  $ph[-1] =~ s/require '[^']+';//gs;
  while ($ph[-1] =~ s/eval\s*'(sub CTL.*?)'\s*unless\s*[^;]*;/$1/gs) {
   my $tmp = my $temp = $1;
   $tmp =~ s/\\'/'/gs;
   $ph[-1] =~ s/$temp/$tmp/s;
  }
  $ph[-1] =~ s/\[\d\]//gs;
  $ph[-1] =~ s/sizeof{ \&([^}]+)}/sizeof{\"$1\"}/gs;
 }
 else {
  $ph[-1] =~ s/struct //gs;
  $ph[-1] =~ s/require '[^']+';//gs;
  $ph[-1] =~ s/eval\s*'(.*?)'\s*unless\s*[^;]*;/$1/gs;
  $ph[-1] =~ s/\\'/'/gs;
  $ph[-1] =~ s/\[\d\]//gs;
  $ph[-1] =~ s/sizeof{ \&([^}]+)}/sizeof{\"$1\"}/gs;
 }
}

my $ph = join("", @ph);

open(SIZEOF, ">$output");
print SIZEOF << "EOF";
package $package;

use vars qw/ \$VERSION \@ISA /;
\$VERSION = '$version';

$sizeof

sub sizeof {
 return (\@sizeof{\@_});
}
EOF

$" = ",";
foreach (keys(%structfuncs)) {
  if ($sizeof{$_}) {
    print SIZEOF
    "sub $_ {\n  my %tmp = %{\$_[0]};\n  return
  pack(\"$structfuncs{$_}\",\n    ";
    print SIZEOF join(", ", @{$structvals{$_}});
    print SIZEOF "\n  )\n}\n";
    print SIZEOF 
    "sub unp_$_ {
  my \$i;
  my \$tmp = shift;
  return {
    map {
      (@{$structinfo{$_}})[\$i++] =>
      \$_
    }
    $structunpack{$_}
  }\n}\n";
  }
  else {
   print SIZEOF "sub $_ { }\n";
   print SIZEOF "sub unp_$_ { }\n";
  }
}
$" = " ";

print SIZEOF << "EOF";
$ph
1;
__END__

=head1 NAME
 
$package - internal module to be used by Packet

=head1 SYNOPSIS

  # you really shouldn't be using this.  really.
  use $package;

  my (\$int_size, \$ifreq_struct_size) = \$${package}::sizeof("int", "ifreq");
  my \$sockaddr_struct_size           = \$${package}::sizeof("sockaddr");
  my \$AF_INET                        = &${package}::AF_INET;

=head1 DESCRIPTION
 
L<$package> is an internal module used by Packet to provide the
size of types, typedefs, and structs and also provide definitions
from standard C headers.

=head1 AUTHORS 
  
Samy Kamkar     <cp5\@LucidX.com>
    
Todd Caine      <tcaine\@eli.net>
    
=head1 SEE ALSO
    
Packet.pm

=cut

EOF
close(SIZEOF);

print "Created $output\n";
exit 0;