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
 201                         };
 202                 } elsif ($tag eq '/member') {
 203                         $ModInfo{$member->{Module}} = $member;
 204                 } elsif ($tag eq '/category') {
 205                         last;
 206                 } else {
 207                         if (! m/^\s*<([a-z]+)>([^<]+)</) {
 208                                 warning "(1) Unknown XML line $_ ($file_name:$.)\n";
 209                                 next
 210                         }
 211                         my ($key, $val) = extract_xml_key($_);
 212                         if ($key eq '') {
 213                                 warning "Unknown XML line $_ ($file_name:$.)\n";
 214                                 next
 215                         }
 216                         if (! exists $member->{$key}) {
 217                                 $member->{$key} = [];
 218                         }
 219                         push @{$member->{$key}}, ($val);
 220                 }
 221         }
 222
 223
 224         close XML;
 225 }
 226
 227 # Dump our data structure to a file.
 228 sub dump_deps($) {
 229         my $file = shift;
 230         open OUTPUT,">$file" or
 231         die "cannot open category file $file for writing: $!\n";
 232
 233         foreach my $mod_name (sort keys %ModInfo) {
 234         print OUTPUT "Key: $mod_name\n";
 235                 my $data = $ModInfo{$mod_name};
 236                 foreach my $var (sort keys %{$data} ) {
 237                         my $val = $$data{$var};
 238                         if (ref($val) eq 'ARRAY') {
 239                                 print OUTPUT $var.": ". (join ", ", @$val)."\n";
 240                         } else {
 241                                 print OUTPUT "$var: $val\n";
 242                         }
 243                 }
 244                 print OUTPUT "\n";
 245         }
 246         close OUTPUT;
 247 }
 248
 249 # Get the available libraries that autoconf generated.
 250 sub get_autoconf_deps() {
 251         open DEPS, $AutoconfDepsFile or
 252                 die "Failed to open $AutoconfDepsFile. Aborting: $!\n";
 253
 254         my @deps_list = (<DEPS>);
 255         foreach (@deps_list){
 256                 chomp;
 257                 my ($lib, $avail) = split(/=/);
 258                 $ModInfo{$lib} = {Type=>'lib', Avail=>$avail};
 259                 if (($avail ne "0") && ($avail ne "1")) {
 260                         warning "Library $lib has invalid availability ".
 261                                 "value <$avail> (check $AutoconfDepsFile).\n";
 262                 }
 263         }
 264         close DEPS;
 265 }
 266
 267 # Read our specific config file.
 268 #
 269 # Its format:
 270 #
 271 #   keyword  values
 272 #
 273 # values are always a spaces-separated list.
 274 sub read_conf() {
 275         open CONF,$ConfFile or return;
 276
 277         while (<CONF>) {
 278                 # remove comments and empty lines:
 279                 chomp;
 280                 s/#.*$//;
 281                 next if /^\s*$/;
 282
 283                 my ($keyword, @value) = split;
 284
 285                 if ($keyword eq 'exclude') {
 286                         push @ExcludedModules, @value;
 287                 } elsif ($keyword eq 'include') {
 288                         push @IncludedModules, @value;
 289                 } elsif ($keyword eq 'require') {
 290                         push @RequiredModules, @value;
 291                 } elsif ($keyword eq 'random') {
 292                         $RandomKnockoutFactor = $value[0] / 100;
 293                 } else {
 294                         warning "unknown keyword $keyword in line $. of $ConfFile.";
 295                 }
 296         }
 297 }
 298
 299 # generate menuselect.makedeps.
 300 # In this file menuselect writes dependecies of each module. CFLAGS will
 301 # then automatically include for each module the _INCLUDE and LDFLAGS
 302 # will include the _LIBS from all the depedencies of the module.
 303 sub gen_makedeps() {
 304         open MAKEDEPSS, ">$MakedepsFile" or
 305                 die "Failed to open deps file $MakedepsFile for writing. Aborting: $!\n";
 306
 307         for my $mod_name (sort keys %ModInfo) {
 308                 next unless ($ModInfo{$mod_name}{Type} eq 'module');
 309
 310                 my $mod = $ModInfo{$mod_name};
 311                 my @deps = ();
 312
 313                 # if we have Depend or Use, put their values into
 314                 # @deps . If we have none, move on.
 315                 push @deps, @{$mod->{Depend}} if (exists $mod->{Depend});
 316                 push @deps, @{$mod->{Use}}    if (exists $mod->{Use});
 317                 next unless @deps;
 318
 319                 # TODO: don't print dependencies that are not external libs.
 320                 # Not done yet until I figure out if this is safe.
 321                 my $dep = join(' ', @deps);
 322                 print MAKEDEPSS "MENUSELECT_DEPENDS_".$mod->{Module}."=$dep\n";
 323         }
 324
 325         close MAKEDEPSS;
 326 }
 327
 328 # Set modules from patterns specified by 'exclude' in the configuration file
 329 # to exclude modules from building (mark them as unavailable).
 330 sub apply_excluded_patterns() {
 331         foreach my $pattern (@ExcludedModules) {
 332                 my @excluded = grep {/^$pattern$/i} (keys %ModInfo);
 333                 foreach (@excluded) {
 334                         $ModInfo{$_}{Avail} = 0;
 335                 }
 336         }
 337 }
 338
 339 # Set modules from patterns specified by 'include' in the configuration
 340 # file to exclude from building (mark them as available).
 341 sub apply_included_patterns() {
 342         foreach my $pattern (@IncludedModules) {
 343                 my @included = grep {/^$pattern$/i} (keys %ModInfo);
 344                 foreach (@included) {
 345                         $ModInfo{$_}{Avail} = 1;
 346                 }
 347         }
 348 }
 349
 350 # If user set the "random" config to anything > 0, drop some random
 351 # modules. May help expose wrong dependencies.
 352 sub apply_random_drop() {
 353         return if ($RandomKnockoutFactor <= 0);
 354
 355         open MODS_LIST, ">$RandomeModsFile" or
 356                 die "Failed to open modules list file $RandomeModsFile for writing. Aborting: $!\n";
 357         for my $mod (keys %ModInfo) {
 358                 next unless ($ModInfo{$mod}{Type} eq 'module');
 359                 next unless (rand() < $RandomKnockoutFactor);
 360                 $ModInfo{$mod}{Avail} = 0;
 361                 $ModInfo{$mod}{RandomKill} = 1;
 362                 print MODS_LIST $ModInfo{$mod}{Module}."\n";
 363         }
 364
 365         close MODS_LIST;
 366
 367
 368 }
 369
 370 sub check_required_patterns() {
 371         my @failed = ();
 372         foreach my $pattern (@RequiredModules) {
 373                 my @required = grep {/^$pattern$/i} (keys %ModInfo);
 374                 foreach my $mod (@required) {
 375                         if ((! exists $ModInfo{$mod}{Checked}) ||
 376                                 (! $ModInfo{$mod}{Checked}) )
 377                         {
 378                                 push @failed, $mod;
 379                         }
 380                 }
 381         }
 382         return unless (@failed);
 383
 384         my $failed_str = join ' ',@failed;
 385         die("Missing dependencies for the following modules: $failed_str\n");
 386 }
 387
 388 # Disable building for modules that were marked in the embedded module
 389 # information as disabled for building by default.
 390 sub apply_default_enabled() {
 391         foreach my $mod (keys %ModInfo) {
 392                 if ((exists $ModInfo{$mod}{Defaultenabled}) &&
 393                                 $ModInfo{$mod}{Defaultenabled}[0] eq 'no')
 394                 {
 395                         $ModInfo{$mod}{Avail} = 0;
 396                 }
 397         }
 398 }
 399
 400 # recursively check dependency for a module.
 401 #
 402 # We run a scan for modules. Modules marked as 'Checked' are ones we
 403 # have already fully verified to have proper dependencies.
 404 #
 405 # We can only use a module or library marked as Avail => 1 (library
 406 # available or module not excluded).
 407 sub check_module($);
 408 sub check_module($) {
 409         my $mod = shift;
 410
 411         # we checked it:
 412         if (exists $ModInfo{$mod}{Checked}) {
 413                 return $ModInfo{$mod}{Checked};
 414         }
 415         # A library has no dependencies of its own.
 416         if ($ModInfo{$mod}{Type} eq 'lib') {
 417                 return ($ModInfo{$mod}{Avail} || 0);
 418         }
 419         # An excluded module.
 420         if ($ModInfo{$mod}{Avail} == 0) {
 421                 return 0;
 422         }
 423         # XML inputs have a reversed logic: no 'defaultenabled' means 'no'
 424         # And we need to actually print enabled ones, rather than disabled
 425         # ones.
 426         if ($ModInfo{$mod}{Type} eq 'XML') {
 427                 my $res = ((not exists $ModInfo{$mod}{Defaultenabled}) ||
 428                         ($ModInfo{$mod}{Defaultenabled}[0] ne 'yes') );
 429                 $ModInfo{$mod}{Checked} = $res;
 430                 return $res;
 431         }
 432         # no dependencies to check:
 433         if (! exists $ModInfo{$mod}{Depend}) {
 434                 $ModInfo{$mod}{Checked} = 1;
 435                 return 1;
 436         }
 437
 438         my $deps_checked = 1; # may be reset below on failures:
 439
 440         if (exists $ModInfo{$mod}{Tested}) {
 441                 # this probably means a circular dependency of some sort.
 442                 warning "Got to module $mod that is already tested.";
 443         }
 444         $ModInfo{$mod}{Tested} = 1;
 445
 446         foreach my $dep_mod (@{$ModInfo{$mod}{Depend}} ) {
 447                 if (!exists ${ModInfo}{$dep_mod}) {
 448                         # TODO: die here? This should never happen.
 449                         warning "module $mod depends on $dep_mod that does not exist.";
 450                         next;
 451                 }
 452                 $deps_checked &= check_module($dep_mod);
 453                 last if(!$deps_checked) # no point testing further if we failed.
 454         }
 455
 456         $ModInfo{$mod}{Checked} = $deps_checked;
 457         return $deps_checked;
 458 }
 459
 460 # The main dependency resolver function.
 461 sub resolve_deps() {
 462         apply_default_enabled();
 463         apply_excluded_patterns();
 464         apply_included_patterns();
 465
 466         foreach my $mod (keys %ModInfo) {
 467                 check_module($mod);
 468         }
 469 }
 470
 471 # generate menuselect.makeopts. Please let me know if some parts are
 472 # still missing.
 473 sub gen_makeopts() {
 474         open MAKEDEPS, ">$MakeoptsFile" or
 475                 die "Failed to open opts file $MakeoptsFile for writing. Aborting: $!\n";
 476
 477         my %Subdirs;
 478         foreach my $mod (sort keys %ModInfo) {
 479                 next unless ($ModInfo{$mod}{Type} =~ /^(module|XML)$/);
 480                 next if ($ModInfo{$mod}{Checked});
 481                 my $dir = $ModInfo{$mod}{Dir};
 482                 if (! exists $Subdirs{$dir}) {
 483                         $Subdirs{$dir} = [];
 484                 }
 485                 push @{$Subdirs{$dir}},( $ModInfo{$mod}{Module} );
 486         }
 487         foreach my $dir (sort keys %Subdirs) {
 488                 my $deps = join(' ', @{$Subdirs{$dir}});
 489                 print MAKEDEPS "MENUSELECT_$dir=$deps\n";
 490         }
 491
 492         close MAKEDEPS;
 493 }
 494
 495 #
 496 # The main program start here
 497 #
 498
 499 read_conf();
 500
 501 extract_subdirs(@Subdirs);
 502
 503 parse_menuselect_xml_file('build_tools/cflags.xml');
 504 parse_menuselect_xml_file('sounds/sounds.xml');
 505
 506 apply_random_drop();
 507
 508 get_autoconf_deps();
 509
 510 #dump_deps('build_tools/dump_deps_before_resolve');
 511 resolve_deps();
 512
 513 # Handy debugging:
 514 dump_deps('build_tools/dump_deps');
 515
 516 check_required_patterns();
 517
 518 gen_makedeps();
 519
 520 gen_makeopts();