menuselect/menuselect

   1 #!/usr/bin/perl -w
   2
   3 # menuselect - a simple drop-in replacement of the batch-mode menuselect
   4 # included with Asterisk.
   5 #
   6 # Copyright (C) 2008 by Tzafrir Cohen <tzafrir.cohen@xorcom.com>
   7 #
   8 # This program is free software; you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 2 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program; if not, write to the Free Software
  20 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
  21 # USA
  22
  23 # Installation: copy this script to menuselect/menuselect . Copy the
  24 # included Makefile as menuselect/Makefile and run:
  25 #
  26 #   make -C makefile dummies
  27 #
  28 # It takes configuration from build_tools/conf . Sample config file:
  29 #
  30 #   By default all modules will be built (except those marked not be
  31 #   used by default)
  32 #
  33 #   # exclude: Don't try to build the following modules.
  34 #   #exclude app_test
  35 #
  36 #   # You can have multiple items in each line, and multiple lines.
  37 #   # Each item is a perl regular expression that must match the whole
  38 #   # module name.
  39 #   #exclude res_config_.*
  40 #
  41 #   # include: syntax is the same as exclude. Overrides exclude and
  42 #   # modules that are marked as disabled by defualt:
  43 #   #include res_config_sqlite3 app_skel
  44 #
  45 #   # If you want to make sure some modules will be conifgured to build,
  46 #   # you can require them. If modules that match any of the 'require'
  47 #   # pattern are not configured to build, menuselect will panic.
  48 #   # Same pattern rules apply here. Why would you want that? I have no
  49 #   # idea.
  50 #   #require chan_h323 app_directory
  51 #
  52 #   # random - the value for this keyword is a number between 1 and
  53 #   # 100. The higher it is, more chances not to include each module.
  54 #   # Writes the list of modules that got hit to
  55 #   # build_tools/mods_removed_random .
  56 #   # Note that unlike 'make randomconfig' and such the random
  57 #   # configuration changes each time you run 'make', thus if a build
  58 #   # failed you should first read build_tools/mods_removed_random
  59 #   # before re-running make.
  60 #   #random 10
  61 #
  62 #   # Anything after a '#' is ignored, and likewise empty lines.
  63 #   # Naturally.
  64
  65 use strict;
  66
  67 # Holds global dependncy information. Keys are module names.
  68 my %ModInfo = ();
  69
  70 # extract configuration from kernel modules:
  71 my $AutoconfDepsFile = "build_tools/menuselect-deps";
  72
  73 # configuration file to read for some directives:
  74 my $ConfFile = "build_tools/conf";
  75
  76 # Modules removed randomely:
  77 my $RandomeModsFile = "build_tools/mods_removed_random";
  78
  79 my $MakedepsFile = "menuselect.makedeps";
  80
  81 my $MakeoptsFile = "menuselect.makeopts";
  82
  83 # If those modules are not present, the build will fail (PCRE patterns)
  84 my @RequiredModules = ();
  85
  86 my @Subdirs = qw/apps cdr channels codecs formats funcs main pbx res utils/;
  87
  88 my @XmlCategories = 'cflags';
  89
  90 # Modules should not bother building (PCRE patterns)
  91 my @ExcludedModules = ();
  92
  93 # Do try building those. Overrides 'exclude' and 'defaultenable: no'
  94 my @IncludedModules = ();
  95
  96 # A chance to rule-out a module randomely.
  97 my $RandomKnockoutFactor = 0;
  98
  99 sub warning($) {
 100         my $msg = shift;
 101         print STDERR "$0: Warning: $msg\n";
 102 }
 103
 104 # Convert XML syntax to mail-header-like syntax:
 105 # <var>value</var> --> Var: value
 106 sub extract_xml_key($) {
 107         my $xml_line = shift;
 108         if ($xml_line !~ m{^\s*<([a-zA-Z0-9]*)>([^<]*)</\1>}) {
 109                 warning "parsed empty value from XML line $xml_line";
 110                 return ('', ''); # warn?
 111         }
 112         my ($var, $val) = ($1, $2);
 113         $var =~ s{^[a-z]}{\u$&};
 114         return ($var, $val);
 115 }
 116
 117 # Get information embedded in source files from a subdirectory.
 118 # First parameter is the subdirectory and further ones are the actual
 119 # source files.
 120 sub get_subdir_module_info {
 121         my $subdir = shift;
 122         my @files = @_;
 123
 124         my $dir = uc($subdir);
 125
 126         foreach my $src (@files) {
 127                 open SRC,$src or die "Can't read from source file $src: $!\n";
 128                 $src =~ m|.*/([^/]*)\.c|;
 129                 my $mod_name = $1;
 130                 my %data = (
 131                         Type=>'module',
 132                         Module=>$mod_name,
 133                         Dir=> $dir,
 134                         Avail=>1
 135                 );
 136
 137                 while (<SRC>) {
 138                         next unless (m|^/\*\*\* MODULEINFO| .. m|^ ?\*\*\*/|);
 139                         next unless (m|^[A-Z]| || m|^\s*<|);
 140
 141                         # At this point we can assume we're in the module
 142                         # info section.
 143                         chomp;
 144                         my ($var, $val) = extract_xml_key($_);
 145
 146                         if ($var =~ /^(Depend|Use)$/i) {
 147                                 # use uppercase for dependency names;
 148                                 $val = uc($val);
 149                         }
 150                         if ( ! exists $data{$var} ) {
 151                                 $data{$var} = [$val];
 152                         } else {
 153                                 push @{$data{$var}},($val);
 154                         }
 155                 }
 156                 close SRC;
 157
 158                 $ModInfo{uc($mod_name)} = \%data;
 159         }
 160 }
 161
 162 # extract embedded information in all the source tree.
 163 sub extract_subdirs {
 164         for my $subdir(@_) {
 165                 get_subdir_module_info($subdir, <$subdir/*.c> , <$subdir/*.cc>);
 166         }
 167 }
 168
 169 # parse a partial XML document that is included as an input
 170 # for menuselect in a few places. Naturally a full-fledged XML parsing
 171 # will not be done here. A line-based parsing that happens to work will
 172 # have to do.
 173 sub parse_menuselect_xml_file($) {
 174         my $file_name = shift;
 175         open XML,$file_name or
 176                 die "Failed opening XML file $file_name: $!.\n";
 177
 178         my $header = <XML>;
 179         $header =~ /^\s*<category\s+name="MENUSELECT_([^"]+)"\s/;
 180         my $category = $1;
 181         my $member;
 182
 183         while(<XML>){
 184                 next unless (m{^\s*<(/?[a-z]+)[>\s]});
 185                 my $tag = $1;
 186
 187                 if ($tag eq 'member') {
 188                         if (! m{^\s*<member\s+name="([^"]+)" displayname="([^"]+)"\s*>}){
 189                                 warning "Bad XML member line: $_ ($file_name:$.)\n";
 190                                 next;
 191                         }
 192                         my ($name, $display_name) = ($1, $2);
 193
 194                         $member = {
 195                                 Type => 'XML',
 196                                 Dir => $category,
 197                                 Module => $1,
 198                                 DisplayName => $2,
 199                                 Avail => 1,
 200                                 Want => 0,
 201
 202                         };
 203                 } elsif ($tag eq '/member') {
 204                         $ModInfo{$member->{Module}} = $member;
 205                 } elsif ($tag eq '/category') {
 206                         last;
 207                 } else {
 208                         if (! m/^\s*<([a-z]+)>([^<]+)</) {
 209                                 warning "(1) Unknown XML line $_ ($file_name:$.)\n";
 210                                 next
 211                         }
 212                         my ($key, $val) = extract_xml_key($_);
 213                         if ($key eq '') {
 214                                 warning "Unknown XML line $_ ($file_name:$.)\n";
 215                                 next
 216                         }
 217                         if (! exists $member->{$key}) {
 218                                 $member->{$key} = [];
 219                         }
 220                         push @{$member->{$key}}, ($val);
 221                 }
 222         }
 223
 224
 225         close XML;
 226 }
 227
 228 # Dump our data structure to a file.
 229 sub dump_deps($) {
 230         my $file = shift;
 231         open OUTPUT,">$file" or
 232         die "cannot open category file $file for writing: $!\n";
 233
 234         foreach my $mod_name (sort keys %ModInfo) {
 235         print OUTPUT "Key: $mod_name\n";
 236                 my $data = $ModInfo{$mod_name};
 237                 foreach my $var (sort keys %{$data} ) {
 238                         my $val = $$data{$var};
 239                         if (ref($val) eq 'ARRAY') {
 240                                 print OUTPUT $var.": ". (join ", ", @$val)."\n";
 241                         } else {
 242                                 print OUTPUT "$var: $val\n";
 243                         }
 244                 }
 245                 print OUTPUT "\n";
 246         }
 247         close OUTPUT;
 248 }
 249
 250 # Get the available libraries that autoconf generated.
 251 sub get_autoconf_deps() {
 252         open DEPS, $AutoconfDepsFile or
 253                 die "Failed to open $AutoconfDepsFile. Aborting: $!\n";
 254
 255         my @deps_list = (<DEPS>);
 256         foreach (@deps_list){
 257                 chomp;
 258                 my ($lib, $avail) = split(/=/);
 259                 $ModInfo{$lib} = {Type=>'lib', Avail=>$avail};
 260                 if (($avail ne "0") && ($avail ne "1")) {
 261                         warning "Library $lib has invalid availability ".
 262                                 "value <$avail> (check $AutoconfDepsFile).\n";
 263                 }
 264         }
 265         close DEPS;
 266 }
 267
 268 # Read our specific config file.
 269 #
 270 # Its format:
 271 #
 272 #   keyword  values
 273 #
 274 # values are always a spaces-separated list.
 275 sub read_conf() {
 276         open CONF,$ConfFile or return;
 277
 278         while (<CONF>) {
 279                 # remove comments and empty lines:
 280                 chomp;
 281                 s/#.*$//;
 282                 next if /^\s*$/;
 283
 284                 my ($keyword, @value) = split;
 285
 286                 if ($keyword eq 'exclude') {
 287                         push @ExcludedModules, @value;
 288                 } elsif ($keyword eq 'include') {
 289                         push @IncludedModules, @value;
 290                 } elsif ($keyword eq 'require') {
 291                         push @RequiredModules, @value;
 292                 } elsif ($keyword eq 'random') {
 293                         $RandomKnockoutFactor = $value[0] / 100;
 294                 } else {
 295                         warning "unknown keyword $keyword in line $. of $ConfFile.";
 296                 }
 297         }
 298 }
 299
 300 # generate menuselect.makedeps.
 301 # In this file menuselect writes dependecies of each module. CFLAGS will
 302 # then automatically include for each module the _INCLUDE and LDFLAGS
 303 # will include the _LIBS from all the depedencies of the module.
 304 sub gen_makedeps() {
 305         open MAKEDEPSS, ">$MakedepsFile" or
 306                 die "Failed to open deps file $MakedepsFile for writing. Aborting: $!\n";
 307
 308         for my $mod_name (sort keys %ModInfo) {
 309                 next unless ($ModInfo{$mod_name}{Type} eq 'module');
 310
 311                 my $mod = $ModInfo{$mod_name};
 312                 my @deps = ();
 313
 314                 # if we have Depend or Use, put their values into
 315                 # @deps . If we have none, move on.
 316                 push @deps, @{$mod->{Depend}} if (exists $mod->{Depend});
 317                 push @deps, @{$mod->{Use}}    if (exists $mod->{Use});
 318                 next unless @deps;
 319
 320                 # TODO: don't print dependencies that are not external libs.
 321                 # Not done yet until I figure out if this is safe.
 322                 my $dep = join(' ', @deps);
 323                 print MAKEDEPSS "MENUSELECT_DEPENDS_".$mod->{Module}."=$dep\n";
 324         }
 325
 326         close MAKEDEPSS;
 327 }
 328
 329 # Set modules from patterns specified by 'exclude' in the configuration file
 330 # to exclude modules from building (mark them as unavailable).
 331 sub apply_excluded_patterns() {
 332         foreach my $pattern (@ExcludedModules) {
 333                 my @excluded = grep {/^$pattern$/i} (keys %ModInfo);
 334                 foreach (@excluded) {
 335                         $ModInfo{$_}{Avail} = 0;
 336                         $ModInfo{$_}{Want} = 0;
 337                 }
 338         }
 339 }
 340
 341 # Set modules from patterns specified by 'include' in the configuration
 342 # file to exclude from building (mark them as available).
 343 sub apply_included_patterns() {
 344         foreach my $pattern (@IncludedModules) {
 345                 my @included = grep {/^$pattern$/i} (keys %ModInfo);
 346                 foreach (@included) {
 347                         $ModInfo{$_}{Avail} = 1;
 348                         $ModInfo{$_}{Want} = 1;
 349                 }
 350         }
 351 }
 352
 353 # If user set the "random" config to anything > 0, drop some random
 354 # modules. May help expose wrong dependencies.
 355 sub apply_random_drop() {
 356         return if ($RandomKnockoutFactor <= 0);
 357
 358         open MODS_LIST, ">$RandomeModsFile" or
 359                 die "Failed to open modules list file $RandomeModsFile for writing. Aborting: $!\n";
 360         for my $mod (keys %ModInfo) {
 361                 next unless ($ModInfo{$mod}{Type} eq 'module');
 362                 next unless (rand() < $RandomKnockoutFactor);
 363                 $ModInfo{$mod}{Avail} = 0;
 364                 $ModInfo{$mod}{RandomKill} = 1;
 365                 print MODS_LIST $ModInfo{$mod}{Module}."\n";
 366         }
 367
 368         close MODS_LIST;
 369
 370
 371 }
 372
 373 sub check_required_patterns() {
 374         my @failed = ();
 375         foreach my $pattern (@RequiredModules) {
 376                 my @required = grep {/^$pattern$/i} (keys %ModInfo);
 377                 foreach my $mod (@required) {
 378                         if ((! exists $ModInfo{$mod}{Checked}) ||
 379                                 (! $ModInfo{$mod}{Checked}) )
 380                         {
 381                                 push @failed, $mod;
 382                         }
 383                 }
 384         }
 385         return unless (@failed);
 386
 387         my $failed_str = join ' ',@failed;
 388         die("Missing dependencies for the following modules: $failed_str\n");
 389 }
 390
 391 # Disable building for modules that were marked in the embedded module
 392 # information as disabled for building by default.
 393 sub apply_default_enabled() {
 394         foreach my $mod (keys %ModInfo) {
 395                 next unless ( exists $ModInfo{$mod}{Defaultenabled});
 396                 my $val = $ModInfo{$mod}{Defaultenabled}[0];
 397
 398                 if ($val eq 'no') {
 399                         $ModInfo{$mod}{Avail} = 0;
 400                         $ModInfo{$mod}{Want} = 0;
 401                 } elsif ($val eq 'yes') {
 402                         $ModInfo{$mod}{Avail} = 1;
 403                         $ModInfo{$mod}{Want} = 1;
 404                 } else {
 405                         warning "Invalid 'defaultenabled' value '$val' for $mod";
 406                 }
 407         }
 408 }
 409
 410 # recursively check dependency for a module.
 411 #
 412 # We run a scan for modules. Modules marked as 'Checked' are ones we
 413 # have already fully verified to have proper dependencies.
 414 #
 415 # We can only use a module or library marked as Avail => 1 (library
 416 # available or module not excluded).
 417 sub check_module($$);
 418 sub check_module($$) {
 419         my $mod = shift;
 420         my $want = shift;
 421
 422         # we checked it:
 423         if (exists $ModInfo{$mod}{Checked}) {
 424                 return $ModInfo{$mod}{Checked};
 425         }
 426         # A library has no dependencies of its own.
 427         if ($ModInfo{$mod}{Type} eq 'lib') {
 428                 return ($ModInfo{$mod}{Avail} || 0);
 429         }
 430         # An excluded module.
 431         if ($ModInfo{$mod}{Avail} == 0) {
 432                 return 0;
 433         }
 434         # XML inputs have a reversed logic: no 'defaultenabled' means 'no'
 435         # And we need to actually print enabled ones, rather than disabled
 436         # ones.
 437         if ($ModInfo{$mod}{Type} eq 'XML') {
 438                 # Nobody wants the module (recursively) and the moudle itself
 439                 # does not have Want set from e.g. include.
 440                 # Do nothing now, in case someone else will want it.
 441                 if (!$want && ( (not exists $ModInfo{$mod}{Want}) ||
 442                         (! $ModInfo{$mod}{Want})) )
 443                 {
 444                         return 0;
 445                 }
 446
 447         }
 448         # no dependencies to check:
 449         if (! exists $ModInfo{$mod}{Depend}) {
 450                 $ModInfo{$mod}{Checked} = 1;
 451                 $ModInfo{$mod}{Want} ||= $want;
 452                 return 1;
 453         }
 454
 455         my $deps_checked = 1; # may be reset below on failures:
 456         if (exists $ModInfo{$mod}{Want}) {
 457                 $want ||= $ModInfo{$mod}{Want};
 458         }
 459
 460         if (exists $ModInfo{$mod}{Tested}) {
 461                 # this probably means a circular dependency of some sort.
 462                 warning "Got to module $mod that is already tested.";
 463         }
 464         $ModInfo{$mod}{Tested} = 1;
 465
 466         foreach my $dep_mod (@{$ModInfo{$mod}{Depend}} ) {
 467                 if (!exists ${ModInfo}{$dep_mod}) {
 468                         # TODO: die here? This should never happen.
 469                         warning "module $mod depends on $dep_mod that does not exist.";
 470                         next;
 471                 }
 472                 $deps_checked &= check_module($dep_mod, $want);
 473                 last if(!$deps_checked) # no point testing further if we failed.
 474         }
 475
 476         $ModInfo{$mod}{Checked} = $deps_checked;
 477         return $deps_checked;
 478 }
 479
 480 # The main dependency resolver function.
 481 sub resolve_deps() {
 482         apply_default_enabled();
 483         apply_excluded_patterns();
 484         apply_included_patterns();
 485
 486         foreach my $mod (keys %ModInfo) {
 487                 check_module($mod, 0);
 488         }
 489 }
 490
 491 # generate menuselect.makeopts. Please let me know if some parts are
 492 # still missing.
 493 sub gen_makeopts() {
 494         open MAKEDEPS, ">$MakeoptsFile" or
 495                 die "Failed to open opts file $MakeoptsFile for writing. Aborting: $!\n";
 496
 497         my %Subdirs;
 498         foreach my $mod (sort keys %ModInfo) {
 499                 if ($ModInfo{$mod}{Type} eq 'module') {
 500                         next if ((exists $ModInfo{$mod}{Checked}) && $ModInfo{$mod}{Checked});
 501                 } elsif ($ModInfo{$mod}{Type} eq 'XML') {
 502                         next unless ($ModInfo{$mod}{Want} && $ModInfo{$mod}{Checked});
 503                 } else {
 504                         next;
 505                 }
 506                 my $dir = $ModInfo{$mod}{Dir};
 507                 if (! exists $Subdirs{$dir}) {
 508                         $Subdirs{$dir} = [];
 509                 }
 510                 push @{$Subdirs{$dir}},( $ModInfo{$mod}{Module} );
 511         }
 512         foreach my $dir (sort keys %Subdirs) {
 513                 my $deps = join(' ', @{$Subdirs{$dir}});
 514                 print MAKEDEPS "MENUSELECT_$dir=$deps\n";
 515         }
 516
 517         close MAKEDEPS;
 518 }
 519
 520 #
 521 # The main program start here
 522 #
 523
 524 read_conf();
 525
 526 extract_subdirs(@Subdirs);
 527
 528 parse_menuselect_xml_file('build_tools/cflags.xml');
 529 # We're only supposed to enable those if dev mode is enabled.
 530 # but for that I need to parse makeopts .
 531 parse_menuselect_xml_file('build_tools/cflags-devmode.xml');
 532 parse_menuselect_xml_file('sounds/sounds.xml');
 533
 534 apply_random_drop();
 535
 536 get_autoconf_deps();
 537
 538 #dump_deps('build_tools/dump_deps_before_resolve');
 539 resolve_deps();
 540
 541 # Handy debugging:
 542 dump_deps('build_tools/dump_deps');
 543
 544 check_required_patterns();
 545
 546 gen_makedeps();
 547
 548 gen_makeopts();