48e199b421e95443d91666584ab9d40300379233
[sip-router] / doc / scripts / cdefs2doc / dump_cfg_defs.pl
1 #!/usr/bin/perl
2
3 #
4 # Generate docs from ser/sip-router cfg group descriptions
5 # (run on files generated by gcc -fdump-translation-unit -c file.c, 
6 #  try -h for help)
7 # E.g.: dump_cfg_defs.pl --file cfg_core.c  --defs="-DUSE_SCTP ..."
8 #
9 # History:
10 # =======
11 #  2009-10-16  initial version (Andrei Pelinescu-Onciul <andrei@iptel.org>)
12 #
13
14 # Note: uses GCC::TranslationUnit (see cpan) with the following patch:
15 #@@ -251,6 +251,8 @@
16 #           $node->{vector}[$key] = $value;
17 #       } elsif($key =~ /^op (\d+)$/) {
18 #           $node->{operand}[$1] = $value;
19 #+      } elsif ($key eq "val") {
20 #+              push @{$node->{$key}}, ($value) ;
21 #       } else {
22 #           $node->{$key} = $value;
23 #       }
24
25 #
26 # Assumptions:
27 #  - the first array of type cfg_def_t with an initializer is the array
28 #    with the config definitions (name, type, description a.s.o.). Only
29 #    one cfg_def array per file is supported.
30 #  - the first variable of type struct cfg_group_(.*) , with an intializer,
31 #    contains the default values. If no group name is specified on the 
32 #    command line (--group) the group name is derived from the struct
33 #    name ($1). The default values are optional. Only one such variable is
34 #    supported per file.
35 #  - if the number of the default values is different from the number of
36 #    elements in the config defs array, the default values are discarded.
37 #
38 # Output notes:
39 #  - range is not printed if min==max==0.
40 #  - default values are not printed if missing
41
42
43 use strict;
44 use warnings;
45 use Getopt::Long;
46 use File::Temp qw(:mktemp);
47 use File::Basename;
48 use lib "/home/andrei/perl/modules/share/perl/5.10.1";
49 use GCC::TranslationUnit;
50
51 # text printed if we discover that GCC::TranslationUnit is unpatched
52 my $patch_required="$0 requires a patched GCC:TranslationUnit, see the " .
53                                 "comments at the beginning of the file or try --patch\n";
54 # gcc name
55 my $gcc="gcc";
56 # default defines
57 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";
58
59 # file with gcc syntax tree
60 my $file; #"tcp_options.c.001t.tu" ;
61 my $tmp_file;
62 my $src_fname;
63
64 # type to look for
65 my $var_type="cfg_def_t";
66
67 my $tu;
68 my $node;
69 my $i;
70 my @cfg_defs; # filled with config var definition (cfg_def_t)
71 my @cfg_default; # filled with config var defaults
72 my ($cfg_grp_name, $def_cfg_name, $cfg_var_name);
73
74 my ($opt_help, $opt_txt, $opt_is_tu, $dbg, $opt_grp_name, $opt_patch);
75 my ($opt_force_grp_name, $opt_docbook);
76
77 # default output formats
78 my $output_format_header="HEADER";
79 my $output_format_footer="FOOTER";
80 my $output_format_varline="VARLINE2";
81
82
83 sub show_patch
84 {
85 my $patch='
86 --- GCC/TranslationUnit.pm.orig 2009-10-16 17:57:51.275963053 +0200
87 +++ GCC/TranslationUnit.pm      2009-10-16 20:17:28.128455959 +0200
88 @@ -251,6 +251,8 @@
89             $node->{vector}[$key] = $value;
90         } elsif($key =~ /^op (\d+)$/) {
91             $node->{operand}[$1] = $value;
92 +       } elsif ($key eq "val") {
93 +               push @{$node->{$key}}, ($value) ;
94         } else {
95             $node->{$key} = $value;
96         }
97 ';
98
99 print $patch;
100 }
101
102
103 sub help
104 {
105         #print "Usage: $0 --file fname [--src src_fname] [--txt|-t] [--help|-h]\n";
106         $~ = "USAGE";
107         write;
108
109 format USAGE =
110 Usage @*  -f filename | --file filename  [options...]
111       $0
112 Options:
113          -f        filename    - use filename for input (see also -T/--tu).
114          --file    filename    - same as -f.
115          -h | -? | --help      - this help message.
116          -D | --dbg | --debug  - enable debugging messages.
117          -d | --defs           - defines to be passed on gcc's command line
118                                  (e.g. --defs="-DUSE_SCTP -DUSE_TCP").
119          -g | --grp  name
120          --group     name      - config group name used if one cannot be
121                                  autodetected (e.g. no default value 
122                                  intializer present in the file).
123          -G | --force-grp name
124          --force-group    name - force using a config group name, even if one
125                                  is autodetected (see also -g).
126          --gcc     gcc_name    - run gcc_name instead of gcc.
127          -t | --txt            - text mode output.
128          --docbook | --xml     - docbook output (xml).
129          -T | --tu             - the input file is in raw gcc translation
130                                  unit format (as produced by
131                                    gcc -fdump-translation-unit -c ). If not
132                                  present it's assumed that the file contains
133                                  C code.
134          -s | --src | --source - name of the source file, needed only if
135                                  the input file is in "raw" translation
136                                  unit format (--tu) and usefull to restrict
137                                  and speed-up the search.
138          --patch               - show patches needed for the
139                                  GCC::TranslationUnit package.
140 .
141
142 }
143
144
145
146 # escape a string for xml use
147 # params: string to be escaped
148 # return: escaped string
149 sub xml_escape{
150         my $s=shift;
151         my %escapes = (
152                 '"' => '&quot;',
153                 "'" => '&apos;',
154                 '&' => '&amp;',
155                 '<' => '&lt;',
156                 '>' => '&gt;'
157         );
158         
159         $s=~s/(["'&<>])/$escapes{$1}/g;
160         return $s;
161 }
162
163
164
165 # escape a string according with the output requirements
166 # params: string to be escaped
167 # return: escaped string
168 sub output_esc{
169         return xml_escape(shift) if defined $opt_docbook;
170         return shift;
171 }
172
173
174
175 # eliminate casts and expressions.
176 # (always go on the first operand)
177 # params: node (GCC::Node)
178 # result: if node is an expression it will walk on operand(0) until first non
179 # expression element is found
180 sub expr_op0{
181         my $n=shift;
182         
183         while(($n->isa('GCC::Node::Expression') || $n->isa('GCC::Node::Unary')) &&
184                         defined $n->operand(0)) {
185                 $n=$n->operand(0);
186         }
187         return $n;
188 }
189
190
191
192 # read command line args
193 if ($#ARGV < 0 || ! GetOptions( 'help|h|?' => \$opt_help,
194                                                                 'file|f=s' => \$file,
195                                                                 'txt|t' => \$opt_txt,
196                                                                 'docbook|xml' => \$opt_docbook,
197                                                                 'tu|T' => \$opt_is_tu,
198                                                                 'source|src|s=s' => \$src_fname,
199                                                                 'defs|d=s'=>\$c_defs,
200                                                                 'group|grp|g=s'=>\$opt_grp_name,
201                                                                 'force-group|force-grp|G=s' =>
202                                                                                                         \$opt_force_grp_name,
203                                                                 'dbg|debug|D'=>\$dbg,
204                                                                 'gcc=s' => \$gcc,
205                                                                 'patch' => \$opt_patch) ||
206                 defined $opt_help) {
207         do { show_patch(); exit 0; } if (defined $opt_patch);
208         select(STDERR) if ! defined $opt_help;
209         help();
210         exit((defined $opt_help)?0:1);
211 }
212
213 do { show_patch(); exit 0; } if (defined $opt_patch);
214 do { select(STDERR); help(); exit 1 } if (!defined $file);
215
216 if (defined $opt_txt){
217         $output_format_header="HEADER";
218         $output_format_footer="FOOTER";
219         $output_format_varline="VARLINE2";
220 }elsif (defined $opt_docbook){
221         $output_format_header="DOCBOOK_HEADER";
222         $output_format_footer="DOCBOOK_FOOTER";
223         $output_format_varline="DOCBOOK_VARLINE";
224 }
225
226 if (! defined $opt_is_tu){
227         # file is not a gcc translation-unit dump
228         # => we have to create one
229         $src_fname=basename($file);
230         $tmp_file = "/tmp/" . mktemp ("dump_translation_unit_XXXXXX");
231         system("$gcc -fdump-translation-unit $c_defs -c $file -o $tmp_file.o && \
232                         mv \"$src_fname\".001t.tu  $tmp_file") == 0 or
233                 die "$gcc failed to generate a translation unit dump from $file";
234         $tu=GCC::TranslationUnit::Parser->parsefile($tmp_file);
235         print(STDERR "src name $src_fname\n") if $dbg;
236         unlink($tmp_file, "$tmp_file.o");
237 }else{
238         $tu=GCC::TranslationUnit::Parser->parsefile($file);
239 }
240
241 print(STDERR "Parsing file $file...\n") if $dbg;
242 #
243 # function_decl: name, type, srcp (source), chan?, body?, link (e.g. extern)
244 # parm_decl: name, type, scpe, srcp, chan, argt, size, algn, used
245 # field_decl: name, type, scpe (scope), srcp, size, algn, bpos (bit pos?)
246 #
247 # array_type: size, algn, elts (elements?), domn ?
248 #
249 #
250 # name as string $node->name->identifier
251 #
252 # E.g.: static cfg_def_t tcp_cfg_def[]= {...}
253 #                        ^^^^^^^^^^^
254 #
255 # @7695 var_decl:  name: @7705   type: @7706    srcp: tcp_options.c:51
256 #                  chan: @7707    init: @7708    size: @7709
257 #                  algn: 256      used: 1
258
259 # @7705 (var name)      identifier_node strg: tcp_cfg_def lngt 11
260 # @7706 (var type)      array_type: size:@7709 algn: 32 elts: @2265 domn: @7718
261 # @7707 (? next ?  )    function_decl: ....
262 # @7708 (intializer)    constructor: lngt: 25
263 #                                    idx : @20      val : @7723    [...]
264 # @7709                 interget_cst: type: @11 low: 5600
265 #
266 # @2265 (array type)    record_type: name: @2256    unql: @2255    size: @2002
267 #                                    algn: 32       tag : struct   flds: @2263
268 # @2256 (type)          type_decl: name: @2264    type: @2265    srcp: cfg.h:73
269 #                                  chan: @2266
270 # @2264 (name)                  identifier_node:  strg: cfg_def_t
271
272 print(STDERR "Searching...\n") if $dbg;
273 $i=0;
274 # iterate on the entire nodes array (returned by gcc), but skipping node 0
275 SEARCH: for $node (@{$tu}[1..$#{$tu}]) {
276         $i++;
277         while($node) {
278                 if (
279                         @cfg_defs == 0 &&  # parse it only once
280                         $node->isa('GCC::Node::var_decl') &&
281                         $node->type->isa('GCC::Node::array_type')  &&
282                         (! defined $src_fname || $src_fname eq "" ||
283                                 $node->source=~"$src_fname")
284                         ){
285                         # found a var decl. that it's an array
286                         # check if it's a valid array type
287                         next if (!(     $node->type->can('elements') &&
288                                                 defined $node->type->elements &&
289                                                 $node->type->elements->can('name') &&
290                                                 defined $node->type->elements->name &&
291                                                 $node->type->elements->name->can('name') &&
292                                                 defined $node->type->elements->name->name)
293                                         );
294                         my $type_name= $node->type->elements->name->name->identifier;
295                         if ($type_name eq $var_type) {
296                                 #printf "tree[$i]: found var %s %s (%s)\n",
297                                 #               $type_name,
298                                 #               $node->name->identifier,v
299                                 #               $node->source;
300                                 #print ("keys:", join " ", keys %$node, "\n");
301                                 #print ("keys init:", join " ", keys %{$node->initial}, "\n");
302                                 if ($node->can('initial') && defined $node->initial) {
303                                         my %c1=%{$node->initial};
304                                         $cfg_var_name=$node->name->identifier;
305                                         if (defined $c1{val}){
306                                                 my $c1_el;
307                                                 die $patch_required if (ref($c1{val}) ne "ARRAY");
308                                                 # iterate on array elem., level 1( top {} )
309                                                 # each element is a constructor
310                                                 for $c1_el (@{$c1{val}}) {
311                                                         # finally we are a the lower {} initializer
312                                                         my %c2=%{$c1_el};
313                                                         my @el=@{$c2{val}};
314                                                         my ($name_n, $type_n, $min_n, $max_n, $fixup_n, 
315                                                                         $pcbk_n, $desc_n)=@el;
316                                                         my ($name, $type, $min, $max, $desc);
317                                                         if ($name_n->isa('GCC::Node::integer_cst')){
318                                                                 printf(" ERROR: integer non-0 name (%d)\n",
319                                                                                 $name_n->low) if ($name_n->low!=0);
320                                                                 if (@cfg_default > 0){
321                                                                         last SEARCH; # exit
322                                                                 }else{
323                                                                         next; # have to look for defaults too
324                                                                 }
325                                                         }
326                                                         $name=expr_op0($name_n)->string;
327                                                         $type=$type_n->low;
328                                                         $min=$min_n->low;
329                                                         $max=$max_n->low;
330                                                         $desc=expr_op0($desc_n)->string;
331                                                         push @cfg_defs, [$name, $type, $min, $max, $desc];
332                                                 }
333                                         }
334                                 }
335                         }
336                 }elsif (@cfg_default == 0 && # parse it only once
337                                 $node->isa('GCC::Node::var_decl') &&
338                                 $node->type->isa('GCC::Node::record_type') &&
339                                 (! defined $src_fname || $src_fname eq "" ||
340                                         $node->source=~"$src_fname") &&
341                                 defined $node->type->name->can('identifier') &&
342                                 $node->type->name->identifier=~"cfg_group_([a-z0-9_]+)" &&
343                                 $node->can('initial') && defined $node->initial) {
344                                 my %c1=%{$node->initial};
345                                 if (defined $c1{val}){
346                                         my $c1_el;
347                                         $cfg_grp_name=$1;
348                                         $def_cfg_name=$node->name->identifier;
349                                         print(STDERR "found default cfg: $def_cfg_name,", 
350                                                                 "grp $cfg_grp_name\n") if $dbg;
351                                         die $patch_required if (ref($c1{val}) ne "ARRAY");
352                                         # iterate on array elem.,( top {} )
353                                         # each element is an integer, expr (string pointer) or
354                                         # constructor (str)
355                                         for $c1_el (@{$c1{val}}) {
356                                                 if ($c1_el->isa('GCC::Node::integer_cst')){
357                                                         push @cfg_default, $c1_el->low;
358                                                 }elsif ($c1_el->isa('GCC::Node::constructor')){
359                                                         push @cfg_default, "<unknown:str>";
360                                                 }else{
361                                                         push @cfg_default, expr_op0($c1_el)->string;
362                                                 }
363                                         }
364                                         last SEARCH if @cfg_defs > 0; # exit
365                                 }
366                 }
367         } continue {
368                 if ($node->can('chain')){
369                         $node = $node->chain;
370                 }else{
371                         last;
372                 }
373         }
374 }
375
376 print(STDERR "Done.\n") if $dbg;
377
378 my ($name, $flags, $min, $max, $desc);
379 my ($type, $extra_txt, $default);
380
381 if (@cfg_defs > 0){
382         my $l;
383         my $no=@cfg_default;
384         $i=0;
385         if ($no > 0 && @cfg_defs != $no) {
386                 print(STDERR "WARNING: different array lenghts ($def_cfg_name($no) &&",
387                                 " $cfg_var_name($(scalar @cfg_defs)))\n");
388                 $no=0;
389         }
390         # dump the configuration in txt mode
391         if (defined $opt_force_grp_name) {
392                 $cfg_grp_name=output_esc($opt_force_grp_name);
393         }elsif (!defined $cfg_grp_name && defined $opt_grp_name) {
394                 $cfg_grp_name=output_esc($opt_grp_name);
395         }
396         $~ = $output_format_header; write;
397         $~ = $output_format_varline ;
398         for $l (@cfg_defs){
399                 ($name, $flags, $min, $max, $desc)=@{$l};
400                 $type="";
401                 $extra_txt="";
402                 $default= ($no>0) ? output_esc($cfg_default[$i]) : "";
403                 
404                 $i++;
405                 if ($min==0 && $max==0) {
406                         $min=""; $max="";
407                 }
408                 if ($flags & 8) {
409                         $type="integer";
410                 }elsif ($flags & 16) {
411                         $type="string";
412                 }elsif ($flags & 32) {
413                         $type="string"; # str
414                 }else{
415                         my $t = $flags & 7;
416                         $t == 1 && do { $type="integer"; };
417                         $t == 2 && do { $type="string"; };
418                         $t == 3 && do { $type="string"; }; # str
419                         $t == 4 && do { $type=""; }; # pointer
420                 }
421                 
422                 $extra_txt.="Read-only." if ($flags & 128 );
423                 $extra_txt=output_esc($extra_txt);
424                 $desc=output_esc($desc . ".");
425                 $name=output_esc($name);
426                 # generate txt description
427                 write;
428         }
429         $~ = $output_format_footer; write;
430 }else{
431         die "no configuration variables found in $file\n";
432 }
433
434
435 sub valid_grp_name
436 {
437         my $name=shift;
438         return defined $name && $name ne "";
439 }
440
441
442 format HEADER =
443 Configuration Variables@*
444 (valid_grp_name $cfg_grp_name) ? " for " . $cfg_grp_name : ""
445 =======================@*
446 "=" x length((valid_grp_name $cfg_grp_name)?" for " . $cfg_grp_name : "")
447
448 @||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
449 "[ this file is autogenerated, do not edit ]"
450
451
452 .
453
454 format FOOTER =
455 .
456
457 format VARLINE =
458 @>. @<<<<<<<<<<<<<<<<<<< - ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
459 $i, $name,                 $desc
460 ~~                         ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
461                            $desc
462 ~                          Default: @*.
463                            $default
464 ~                          Range: @* - @*.
465                                   $min, $max
466 ~                          Type: @*. ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
467                                  $type, $extra_txt
468 ~~                         ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
469                            $extra_txt
470
471 .
472
473 format VARLINE2 =
474 @>. @*
475 $i, (valid_grp_name $cfg_grp_name)?$cfg_grp_name . "." . $name : $name
476 ~~      ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
477         $desc
478 ~       Default: @*.
479                  $default
480 ~       Range: @* - @*.
481                $min, $max
482 ~       Type: @*. ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
483               $type, $extra_txt
484 ~~      ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
485         $extra_txt
486
487 .
488
489 format DOCBOOK_HEADER =
490 <?xml version="1.0" encoding="UTF-8"?>
491 <!-- this file is autogenerated, do not edit! -->
492 <!DOCTYPE section PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
493         "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd">
494 <chapter id="config_vars@*">
495 (valid_grp_name $cfg_grp_name) ? "." . $cfg_grp_name : ""
496         <title> Configuration Variables@*</title>
497 (valid_grp_name $cfg_grp_name) ? " for " . $cfg_grp_name : ""
498
499
500 .
501
502 format DOCBOOK_FOOTER =
503 </chapter>
504 .
505
506 format DOCBOOK_VARLINE =
507 <section id="@*">
508     (valid_grp_name $cfg_grp_name)?$cfg_grp_name . "." . $name : $name
509     <title>@*</title>
510     (valid_grp_name $cfg_grp_name)?$cfg_grp_name . "." . $name : $name
511     <para>
512 ~~      ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
513         $desc
514     </para>
515 ~   <para>Default value: @*.</para>
516         $default
517 ~   <para>Range: @* - @*.</para>
518             $min, $max
519 ~   <para>Type: @*.</para>
520             $type
521     <para>
522 ~~      ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
523         $extra_txt
524     </para>
525 </section>
526
527 .