doc: script to generate cfg var lists from C code
authorAndrei Pelinescu-Onciul <andrei@iptel.org>
Mon, 19 Oct 2009 16:05:25 +0000 (18:05 +0200)
committerAndrei Pelinescu-Onciul <andrei@iptel.org>
Mon, 19 Oct 2009 16:05:25 +0000 (18:05 +0200)
Added a perl script that generates the list of config variables
 defined in a C file.
The script uses gcc to generate a syntax tree structure for an
entire file and then parses and uses the tree to locate
the config vars. definition, initialization and default values.

E.g.: dump_cfg_defs.pl --file ../../../cfg_core.c --grp core
=> ...
31. core.udp_mtu
        fallback to a congestion controlled protocol if send size
        exceeds udp_mtu.
        Default: 0.
        Range: 0 - 65535.
        Type: integer.
...

The config group (--grp) needs to be specified only if it cannot
be auto-detected (under normal circumstances it is auto-detected
from the type name of the variable holding the default values,
e.g.  cfg_group_core).
If the default values are set in the same .c file, they will be
added to the list.

Note: the script requires a patched version of the
GCC:TranslationUnit perl package. To get the patch use:
dump_cfg_defs.pl --patch

doc/scripts/cdefs2doc/dump_cfg_defs.pl [new file with mode: 0755]

diff --git a/doc/scripts/cdefs2doc/dump_cfg_defs.pl b/doc/scripts/cdefs2doc/dump_cfg_defs.pl
new file mode 100755 (executable)
index 0000000..1dd9759
--- /dev/null
@@ -0,0 +1,434 @@
+#!/usr/bin/perl
+
+#
+# Generate docs from ser/sip-router cfg group descriptions
+# (run on files generated by gcc -fdump-translation-unit -c file.c, 
+#  try -h for help)
+# E.g.: dump_cfg_defs.pl --file cfg_core.c  --defs="-DUSE_SCTP ..."
+#
+# History:
+# =======
+#  2009-10-16  initial version (Andrei Pelinescu-Onciul <andrei@iptel.org>)
+#
+
+# Note: uses GCC::TranslationUnit (see cpan) with the following patch:
+#@@ -251,6 +251,8 @@
+#          $node->{vector}[$key] = $value;
+#      } elsif($key =~ /^op (\d+)$/) {
+#          $node->{operand}[$1] = $value;
+#+     } elsif ($key eq "val") {
+#+             push @{$node->{$key}}, ($value) ;
+#      } else {
+#          $node->{$key} = $value;
+#      }
+# 
+#
+# Assumptions:
+#  - the first array of type cfg_def_t with an initializer is the array
+#    with the config definitions (name, type, description a.s.o.). Only
+#    one cfg_def array per file is supported.
+#  - the first variable of type struct cfg_group_(.*) , with an intializer,
+#    contains the default values. If no group name is specified on the 
+#    command line (--group) the group name is derived from the struct
+#    name ($1). The default values are optional. Only one such variable is
+#    supported per file.
+#  - if the number of the default values is different from the number of
+#    elements in the config defs array, the default values are discarded.
+#
+# Output notes:
+#  - range is not printed if min==max==0.
+#  - default values are not printed if missing
+
+
+use strict;
+use warnings;
+use Getopt::Long;
+use File::Temp qw(:mktemp);
+use File::Basename;
+use lib "/home/andrei/perl/modules/share/perl/5.10.1";
+use GCC::TranslationUnit;
+
+# text printed if we discover that GCC::TranslationUnit is unpatched
+my $patch_required="$0 requires a patched GCC:TranslationUnit, see the " .
+                               "comments at the beginning of the file or try --patch\n";
+# gcc name
+my $gcc="gcc";
+# default defines
+my $c_defs="-D__CPU_i386 -D__OS_linux -DSER_VER=2099099 -DPKG_MALLOC -DSHM_MEM  -DSHM_MMAP -DDNS_IP_HACK -DUSE_IPV6 -DUSE_MCAST -DUSE_TCP -DUSE_DNS_CACHE -DUSE_DNS_FAILOVER -DUSE_DST_BLACKLIST -DUSE_NAPTR  -DUSE_TLS -DTLS_HOOKS -DFAST_LOCK   -DCC_GCC_LIKE_ASM -DHAVE_GETHOSTBYNAME2 -DHAVE_UNION_SEMUN -DHAVE_SCHED_YIELD -DHAVE_MSG_NOSIGNAL -DHAVE_MSGHDR_MSG_CONTROL -DHAVE_ALLOCA_H -DHAVE_SCHED_SETSCHEDULER -DHAVE_EPOLL -DUSE_SCTP -DNAME='\"ser\"' -DVERSION='\"2.99.99-pre3\"' -DARCH='\"i386\"' -DOS_QUOTED='\"linux\"' -DSER_MOD_INTERFACE";
+
+# file with gcc syntax tree
+my $file; #"tcp_options.c.001t.tu" ;
+my $tmp_file;
+my $src_fname;
+
+# type to look for
+my $var_type="cfg_def_t";
+
+my $tu;
+my $node;
+my $i;
+my @cfg_defs; # filled with config var definition (cfg_def_t)
+my @cfg_default; # filled with config var defaults
+my ($cfg_grp_name, $def_cfg_name, $cfg_var_name);
+
+my ($opt_help, $opt_txt, $opt_is_tu, $dbg, $opt_grp_name, $opt_patch);
+my $opt_force_grp_name;
+
+
+
+sub show_patch
+{
+my $patch='
+--- GCC/TranslationUnit.pm.orig        2009-10-16 17:57:51.275963053 +0200
++++ GCC/TranslationUnit.pm     2009-10-16 20:17:28.128455959 +0200
+@@ -251,6 +251,8 @@
+           $node->{vector}[$key] = $value;
+       } elsif($key =~ /^op (\d+)$/) {
+           $node->{operand}[$1] = $value;
++      } elsif ($key eq "val") {
++              push @{$node->{$key}}, ($value) ;
+       } else {
+           $node->{$key} = $value;
+       }
+';
+
+print $patch;
+}
+
+
+sub help
+{
+       #print "Usage: $0 --file fname [--src src_fname] [--txt|-t] [--help|-h]\n";
+       $~ = "USAGE";
+       write;
+
+format USAGE =
+Usage @*  -f filename | --file filename  [options...]
+      $0
+Options:
+         -f        filename    - use filename for input (see also -T/--tu).
+         --file    filename    - same as -f.
+         -h | -? | --help      - this help message.
+         -D | --dbg | --debug  - enable debugging messages.
+         -d | --defs           - defines to be passed on gcc's command line
+                                 (e.g. --defs="-DUSE_SCTP -DUSE_TCP").
+         -g | --grp  name
+         --group     name      - config group name used if one cannot be
+                                 autodetected (e.g. no default value 
+                                 intializer present in the file).
+         -G | --force-grp name
+         --force-group    name - force using a config group name, even if one
+                                 is autodetected (see also -g).
+         --gcc     gcc_name    - run gcc_name instead of gcc.
+         -t | --txt            - text mode output.
+         -T | --tu             - the input file is in raw gcc translation
+                                 unit format (as produced by
+                                   gcc -fdump-translation-unit -c ). If not
+                                 present it's assumed that the file contains
+                                 C code.
+         -s | --src | --source - name of the source file, needed only if
+                                 the input file is in "raw" translation
+                                 unit format (--tu) and usefull to restrict
+                                 and speed-up the search.
+         --patch               - show patches needed for the
+                                 GCC::TranslationUnit package.
+.
+
+}
+
+# eliminate casts and expressions.
+# (always go on the first operand)
+# params: node (GCC::Node)
+# result: if node is an expression it will walk on operand(0) until first non
+# expression element is found
+sub expr_op0{
+       my $n=shift;
+       
+       while(($n->isa('GCC::Node::Expression') || $n->isa('GCC::Node::Unary')) &&
+                       defined $n->operand(0)) {
+               $n=$n->operand(0);
+       }
+       return $n;
+}
+
+
+
+# read command line args
+if ($#ARGV < 0 || ! GetOptions(        'help|h|?' => \$opt_help,
+                                                               'file|f=s' => \$file,
+                                                               'txt|t' => \$opt_txt,
+                                                               'tu|T' => \$opt_is_tu,
+                                                               'source|src|s=s' => \$src_fname,
+                                                               'defs|d=s'=>\$c_defs,
+                                                               'group|grp|g=s'=>\$opt_grp_name,
+                                                               'force-group|force-grp|G=s' =>
+                                                                                                       \$opt_force_grp_name,
+                                                               'dbg|debug|D'=>\$dbg,
+                                                               'gcc=s' => \$gcc,
+                                                               'patch' => \$opt_patch) ||
+               defined $opt_help) {
+       do { show_patch(); exit 0; } if (defined $opt_patch);
+       select(STDERR) if ! defined $opt_help;
+       help();
+       exit((defined $opt_help)?0:1);
+}
+
+do { show_patch(); exit 0; } if (defined $opt_patch);
+do { select(STDERR); help(); exit 1 } if (!defined $file);
+
+if (! defined $opt_is_tu){
+       # file is not a gcc translation-unit dump
+       # => we have to create one
+       $src_fname=basename($file);
+       $tmp_file = "/tmp/" . mktemp ("dump_translation_unit_XXXXXX");
+       system("$gcc -fdump-translation-unit $c_defs -c $file -o $tmp_file.o && \
+                       mv \"$src_fname\".001t.tu  $tmp_file") == 0 or
+               die "$gcc failed to generate a translation unit dump from $file";
+       $tu=GCC::TranslationUnit::Parser->parsefile($tmp_file);
+       print(STDERR "src name $src_fname\n") if $dbg;
+       unlink($tmp_file, "$tmp_file.o");
+}else{
+       $tu=GCC::TranslationUnit::Parser->parsefile($file);
+}
+
+print(STDERR "Parsing file $file...\n") if $dbg;
+#
+# function_decl: name, type, srcp (source), chan?, body?, link (e.g. extern)
+# parm_decl: name, type, scpe, srcp, chan, argt, size, algn, used
+# field_decl: name, type, scpe (scope), srcp, size, algn, bpos (bit pos?)
+#
+# array_type: size, algn, elts (elements?), domn ?
+#
+#
+# name as string $node->name->identifier
+#
+# E.g.: static cfg_def_t tcp_cfg_def[]= {...}
+#                        ^^^^^^^^^^^
+#
+# @7695 var_decl:  name: @7705   type: @7706    srcp: tcp_options.c:51
+#                  chan: @7707    init: @7708    size: @7709
+#                  algn: 256      used: 1
+# 
+# @7705 (var name)     identifier_node strg: tcp_cfg_def lngt 11
+# @7706 (var type)     array_type: size:@7709 algn: 32 elts: @2265 domn: @7718
+# @7707 (? next ?  )   function_decl: ....
+# @7708 (intializer)   constructor: lngt: 25
+#                                    idx : @20      val : @7723    [...]
+# @7709                interget_cst: type: @11 low: 5600
+#
+# @2265 (array type)   record_type: name: @2256    unql: @2255    size: @2002
+#                                    algn: 32       tag : struct   flds: @2263
+# @2256 (type)         type_decl: name: @2264    type: @2265    srcp: cfg.h:73
+#                                  chan: @2266
+# @2264 (name)                 identifier_node:  strg: cfg_def_t
+
+print(STDERR "Searching...\n") if $dbg;
+$i=0;
+# iterate on the entire nodes array (returned by gcc), but skipping node 0
+SEARCH: for $node (@{$tu}[1..$#{$tu}]) {
+       $i++;
+       while($node) {
+               if (
+                       @cfg_defs == 0 &&  # parse it only once
+                       $node->isa('GCC::Node::var_decl') &&
+                       $node->type->isa('GCC::Node::array_type')  &&
+                       (! defined $src_fname || $src_fname eq "" ||
+                               $node->source=~"$src_fname")
+                       ){
+                       # found a var decl. that it's an array
+                       # check if it's a valid array type
+                       next if (!(     $node->type->can('elements') &&
+                                               defined $node->type->elements &&
+                                               $node->type->elements->can('name') &&
+                                               defined $node->type->elements->name &&
+                                               $node->type->elements->name->can('name') &&
+                                               defined $node->type->elements->name->name)
+                                       );
+                       my $type_name= $node->type->elements->name->name->identifier;
+                       if ($type_name eq $var_type) {
+                               #printf "tree[$i]: found var %s %s (%s)\n",
+                               #               $type_name,
+                               #               $node->name->identifier,v
+                               #               $node->source;
+                               #print ("keys:", join " ", keys %$node, "\n");
+                               #print ("keys init:", join " ", keys %{$node->initial}, "\n");
+                               if ($node->can('initial') && defined $node->initial) {
+                                       my %c1=%{$node->initial};
+                                       $cfg_var_name=$node->name->identifier;
+                                       if (defined $c1{val}){
+                                               my $c1_el;
+                                               die $patch_required if (ref($c1{val}) ne "ARRAY");
+                                               # iterate on array elem., level 1( top {} )
+                                               # each element is a constructor
+                                               for $c1_el (@{$c1{val}}) {
+                                                       # finally we are a the lower {} initializer
+                                                       my %c2=%{$c1_el};
+                                                       my @el=@{$c2{val}};
+                                                       my ($name_n, $type_n, $min_n, $max_n, $fixup_n, 
+                                                                       $pcbk_n, $desc_n)=@el;
+                                                       my ($name, $type, $min, $max, $desc);
+                                                       if ($name_n->isa('GCC::Node::integer_cst')){
+                                                               printf(" ERROR: integer non-0 name (%d)\n",
+                                                                               $name_n->low) if ($name_n->low!=0);
+                                                               if (@cfg_default > 0){
+                                                                       last SEARCH; # exit
+                                                               }else{
+                                                                       next; # have to look for defaults too
+                                                               }
+                                                       }
+                                                       $name=expr_op0($name_n)->string;
+                                                       $type=$type_n->low;
+                                                       $min=$min_n->low;
+                                                       $max=$max_n->low;
+                                                       $desc=expr_op0($desc_n)->string;
+                                                       push @cfg_defs, [$name, $type, $min, $max, $desc];
+                                               }
+                                       }
+                               }
+                       }
+               }elsif (@cfg_default == 0 && # parse it only once
+                               $node->isa('GCC::Node::var_decl') &&
+                               $node->type->isa('GCC::Node::record_type') &&
+                               (! defined $src_fname || $src_fname eq "" ||
+                                       $node->source=~"$src_fname") &&
+                               defined $node->type->name->can('identifier') &&
+                               $node->type->name->identifier=~"cfg_group_([a-z0-9_]+)" &&
+                               $node->can('initial') && defined $node->initial) {
+                               my %c1=%{$node->initial};
+                               if (defined $c1{val}){
+                                       my $c1_el;
+                                       $cfg_grp_name=$1;
+                                       $def_cfg_name=$node->name->identifier;
+                                       print(STDERR "found default cfg: $def_cfg_name,", 
+                                                               "grp $cfg_grp_name\n") if $dbg;
+                                       die $patch_required if (ref($c1{val}) ne "ARRAY");
+                                       # iterate on array elem.,( top {} )
+                                       # each element is an integer, expr (string pointer) or
+                                       # constructor (str)
+                                       for $c1_el (@{$c1{val}}) {
+                                               if ($c1_el->isa('GCC::Node::integer_cst')){
+                                                       push @cfg_default, $c1_el->low;
+                                               }elsif ($c1_el->isa('GCC::Node::constructor')){
+                                                       push @cfg_default, "<unknown:str>";
+                                               }else{
+                                                       push @cfg_default, expr_op0($c1_el)->string;
+                                               }
+                                       }
+                                       last SEARCH if @cfg_defs > 0; # exit
+                               }
+               }
+       } continue {
+               if ($node->can('chain')){
+                       $node = $node->chain;
+               }else{
+                       last;
+               }
+       }
+}
+
+print(STDERR "Done.\n") if $dbg;
+
+my ($name, $flags, $min, $max, $desc);
+my ($type, $extra_txt, $default);
+
+if (@cfg_defs > 0){
+       my $l;
+       my $no=@cfg_default;
+       $i=0;
+       if ($no > 0 && @cfg_defs != $no) {
+               print(STDERR "WARNING: different array lenghts ($def_cfg_name($no) &&",
+                               " $cfg_var_name($(scalar @cfg_defs)))\n");
+               $no=0;
+       }
+       # dump the configuration in txt mode
+       if (defined $opt_force_grp_name) {
+               $cfg_grp_name=$opt_force_grp_name;
+       }elsif (!defined $cfg_grp_name && defined $opt_grp_name) {
+               $cfg_grp_name=$opt_grp_name;
+       }
+       $~ = "HEADER"; write;
+       $~ = "VARLINE2" ;
+       for $l (@cfg_defs){
+               ($name, $flags, $min, $max, $desc)=@{$l};
+               $type="";
+               $extra_txt="";
+               $default= ($no>0) ? $cfg_default[$i] : "";
+               
+               $i++;
+               if ($min==0 && $max==0) {
+                       $min=""; $max="";
+               }
+               if ($flags & 8) {
+                       $type="integer";
+               }elsif ($flags & 16) {
+                       $type="string";
+               }elsif ($flags & 32) {
+                       $type="string"; # str
+               }else{
+                       my $t = $flags & 7;
+                       $t == 1 && do { $type="integer"; };
+                       $t == 2 && do { $type="string"; };
+                       $t == 3 && do { $type="string"; }; # str
+                       $t == 4 && do { $type=""; }; # pointer
+               }
+               
+               $extra_txt.="Read-only." if ($flags & 128 );
+               $desc.=".";
+               # generate txt description
+               write;
+       }
+}else{
+       die "no configuration variables found in $file\n";
+}
+
+
+sub valid_grp_name
+{
+       my $name=shift;
+       return defined $name && $name ne "";
+}
+
+
+format HEADER =
+Configuration Variables@*
+(valid_grp_name $cfg_grp_name) ? " for " . $cfg_grp_name : ""
+=======================@*
+"=" x length((valid_grp_name $cfg_grp_name)?" for " . $cfg_grp_name : "")
+
+@||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+"[ this file is autogenerated, do not edit ]"
+
+
+.
+
+format VARLINE =
+@>. @<<<<<<<<<<<<<<<<<<< - ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+$i, $name,                 $desc
+~~                         ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                           $desc
+~                          Default: @*.
+                           $default
+~                          Range: @* - @*.
+                                  $min, $max
+~                          Type: @*. ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                                 $type, $extra_txt
+~~                         ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                           $extra_txt
+
+.
+
+format VARLINE2 =
+@>. @*
+$i, (valid_grp_name $cfg_grp_name)?$cfg_grp_name . "." . $name : $name
+~~      ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+        $desc
+~       Default: @*.
+                 $default
+~       Range: @* - @*.
+               $min, $max
+~       Type: @*. ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+              $type, $extra_txt
+~~      ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+        $extra_txt
+
+.