diff options
Diffstat (limited to 'dump_configure.pl')
| -rwxr-xr-x | dump_configure.pl | 569 |
1 files changed, 569 insertions, 0 deletions
diff --git a/dump_configure.pl b/dump_configure.pl new file mode 100755 index 0000000..36bd37a --- /dev/null +++ b/dump_configure.pl @@ -0,0 +1,569 @@ +#!/usr/bin/perl -w + +use DBI qw(:sql_types); +use Getopt::Long; +use File::Basename; +use Cwd qw(abs_path); +use File::Glob qw(:globally); +use File::Spec::Functions qw(abs2rel catfile); +use Data::Dumper; + + +if ( -d dirname(abs_path(__FILE__))."/modules") { + use lib dirname(abs_path(__FILE__))."/modules"; +} else { + use lib qw(/etc/configure-dumper/modules); +} +use SpecialRules; +use DumperCommon; + +use strict; + +# maps configure path to the set of its options. +my %src_path2option; + +my %src_path2help; + +# the same as src_path2option, but for each option variable +# there are alternatives by which we can determine option value. +my %option2alternatives; + +# maps dump file path to the set of pairs: (option, value). +my %build_path2option; +# automatic variables from autoconf, for example: +# autoconf -I glibc -I glibc/libidn -t 'AC_ARG_VAR:${|:::::|}%' glibc/libidn/configure.ac +# the parsing rule <variable>=<value> +my %build_path2variable; +my $UNDEFINED_VALUE = '##########'; + +my $out_db = "configure_opts.db"; +my $autoconf_path = '/usr/local'; +my $gcc_vers = '6.2.1'; +my $project_name; +my $project_version = $gcc_vers; +my $print_help; + +my $usage_help = "Usage: ".basename($0)." src_dir build_dir [--project name] [--project-version version] [--out_db out.db] [--autoconf-path dir]\n". + " src_dir - path to sources\n". + " build_dir - build directory\n". + " out_db - output database filename, by default $out_db\n". + " autoconf-path - base directory for autoconf tools searching, by default '$autoconf_path'\n"; + +my $dump_fname = DumperCommon::dump_filename; # 'dump_vars.txt'; +my ($BEGIN_DUMP_STR, $END_DUMP_STR) = DumperCommon::dump_parsing_strings; + +GetOptions ("project" => \$project_name, + "project-version" => \$project_version, + "out_db=s" => \$out_db, + "autoconf-path=s" => \$autoconf_path, + "help" => \$print_help) or die "$usage_help"; + +if ($print_help) { + print($usage_help); + exit; +} + +my ($src_dir, $build_dir) = @ARGV; + +die "$usage_help" unless (defined $src_dir && defined $build_dir); +die "Can't find source or build dir.\n" unless (-d $src_dir && -d $build_dir); + +# The project autodetection +my %project_detect = ( + 'GNU Compiler Collection' => 'gcc', + 'GNU development tools' => 'binutils', + 'GNU C Library' => 'glibc' +); +my $pr_error1 = "Can't detect the project. Please use the --project option.\n"; +open(my $fh_readme, '<', $src_dir."/README") or die "$pr_error1"; +my $fline = <$fh_readme>; +close($fh_readme); +foreach my $l_readme (keys %project_detect) { + if ( $fline =~ /$l_readme/ ) { + $project_name = $project_detect{$l_readme}; + last; + } +} +die "$pr_error1" unless (defined $project_name); + +print "The $project_name project detected\n"; +#------------------------------------------- + +my %prefix2opp = ( + 'disable' => 'enable', + 'enable' => 'disable', + 'with' => 'without', + 'without' => 'with' +); + +my %ver2autoconf; +my $default_autoconf_v = '2.69'; +my %autoconf2util; + +my $ignore = qr/ + disable + |enable + |with + |without + |without-PACKAGE + |with-PACKAGE + |enable-FEATURE + |disable-FEATURE + |cache-file + |help/x; + +my $enable_opp = 1; +my $alternatives_check = 1; +my $ignore_neg_opts = 1; +my $auto_variables_check = 1; + +my $transl_rules = SpecialRules::get_rules($project_name, $project_version); +my $special_help = SpecialRules::get_help($project_name, $project_version); + +sub get_rdir { + my ($file, $dir) = @_; + my $rdir = dirname($file); + return abs2rel($rdir, $dir); +} + +sub get_configure_fname { + my ($path) = @_; + die "The path is not defined" unless (defined $path); + my $conf_ac = catfile($path, 'configure.ac'); + # Support different names of autoconf script + $conf_ac = catfile($path, 'configure.in') unless ( -f catfile($src_dir, $conf_ac) ); + return unless ( -f catfile($src_dir, $conf_ac) ); + return $conf_ac; +} + +sub parse_opt_alternatives { + my ($path, $opts) = @_; + # my $conf_ac = get_configure_fname($path); + my $conf_ac = $autoconf2util{$path}{'conf_ac'}; + die unless (defined $conf_ac); + + # print("> ".catfile($src_dir, $path)."\n"); + #my $autoconf = get_autoconf("$conf_ac", "-I $src_dir -I $src_dir/$path"); + # my $autoconf = get_autoconf("$src_dir/$conf_ac", "-I $src_dir -I $src_dir/$path"); + my $autoconf = $autoconf2util{$path}{'autoconf'}; + + foreach my $prefix ('with', 'enable') { + my $ucprefix = uc($prefix); + #my $cmd = "$autoconf -I $src_dir -I $src_dir/$path -t 'AC_ARG_$ucprefix:\${|:::::|}%' $conf_ac 2>/dev/null"; + my $cmd = "$autoconf -I $src_dir/$path -t 'AC_ARG_$ucprefix:\${|:::::|}%' $src_dir/$conf_ac 2>/dev/null"; + # print "> $cmd\n"; + open(my $fh, '-|', "$cmd") or die "$!"; + while (my $line = <$fh>) { + chomp $line; + my ($opt, $help, $ifenabled, $ifdisabled) = split(/\|:::::\|/, $line); + my $opt_name = $prefix.'_'.$opt; + $opt_name =~ s/-/_/g; + $option2alternatives{$path}{$opt_name} = (); + if (exists $opts->{$opt_name}) { + foreach my $arg ($ifenabled, $ifdisabled) { + next unless (defined $arg); + chomp($arg); + if ($arg =~ /^(\w+)=(([^\s]*)|(".*?")|('.*?'))$/i) { + $option2alternatives{$path}{$opt_name}{$1}++; + } + } + } else { + warn "WARNING: $conf_ac: $opt_name doesn't match to any configure option\n"; + } + } + close($fh); + } +} + +sub handle_exeptions { + # TODO: add for glibc, binutils + my ($line) = @_; + my $exc_1 = '--enable-serial-[{host,target,build}-]configure'; + $line =~ s/\Q$exc_1\E/--enable-serial-configure/; + return $line; +} + +sub connect_db { + my ($database) = @_; + my $driver = "SQLite"; + my $dsn = "DBI:$driver:dbname=$database"; + my $userid = ""; + my $password = ""; + my $dbh = DBI->connect($dsn, $userid, $password, { RaiseError => 1, PrintError => 0 }) + or die $DBI::errstr; + return $dbh; +} + +sub create_db_table { + my ($dbh) = @_; + my $sth = $dbh->prepare(q{ + CREATE TABLE OPTIONS ( + PATH TEXT NOT NULL, + NAME TEXT NOT NULL, + VALUE TEXT NOT NULL, + HELP TEXT + );}); + $sth->execute() or die $sth->errstr; +} + +sub insert_db_row { + my ($dbh, $path, $name, $val, $help) = @_; + my $sth = $dbh->prepare(q{ + INSERT INTO OPTIONS( + PATH,NAME,VALUE,HELP) + VALUES (?, ?, ?, ?) + }); + $sth->bind_param( 1, $path, SQL_VARCHAR); + $sth->bind_param( 2, $name, SQL_VARCHAR); + $sth->bind_param( 3, $val, SQL_VARCHAR); + $sth->bind_param( 4, $help, SQL_VARCHAR); + $sth->execute() or die $sth->errstr; +} + +# For the given configure.ac returns path to autoconf +# which is able to parse it. +sub get_autoconf { + my ($conf_ac, $inc_dirs) = @_; + my $autoconf = $ver2autoconf{$default_autoconf_v}; + my $cmd = "$autoconf $inc_dirs -t 'AC_PREREQ' $conf_ac >/dev/null 2>&1"; + my $result = system($cmd); + # print("> Check '$cmd': $result ".($result == 0 ? "success" : "fail")."\n"); + + return $autoconf if ($result == 0); + + foreach my $autoconf_v (reverse sort keys %ver2autoconf) { + next if ("$autoconf_v" eq "$default_autoconf_v"); + + $autoconf = $ver2autoconf{$autoconf_v}; + $cmd = "$autoconf $inc_dirs -t 'AC_PREREQ' $conf_ac >/dev/null 2>&1"; + $result = system($cmd); + # print("> Check '$cmd': $result ".($result == 0 ? "success" : "fail")."\n"); + return $autoconf if ($result == 0); + } + die "Couldn't find right autoconf version for $conf_ac"; +} + +sub get_auto_variables { + my ($path) = @_; + unless (defined $path) { + warn "WARNING: undefined path\n"; + return; + } + die unless (defined $autoconf2util{$path}{'conf_ac'} && defined $autoconf2util{$path}{'autoconf'}); + my $conf_ac = $autoconf2util{$path}{'conf_ac'}; + my $autoconf = $autoconf2util{$path}{'autoconf'}; + my $cmd = "$autoconf -I $src_dir -I $src_dir/$path -t 'AC_ARG_VAR:\${|:::::|}%' $src_dir/$conf_ac 2>/dev/null"; + # print("> $cmd\n"); + open(my $fh, '-|', "$cmd") or die "$!"; + while (my $line = <$fh>) { + chomp $line; + my ($opt, $help) = split(/\|:::::\|/, $line); + unless (defined $help) { + $help = ''; + warn "WARNING: $path:$opt - help message is undefined (for variable)\n"; + } + # print("$opt -> $help"); + # $build_path2variable{$path}{$opt}{'value'} = $UNDEFINED_VALUE; + $build_path2variable{$path}{$opt}{'help'} = $help; + } + close($fh); +} + +# find available 'autoconf' versions +my @autoconf_dirs = <$autoconf_path/autoconf-2.*>; + +foreach my $autconf_dir (@autoconf_dirs) { + if ($autconf_dir =~ /autoconf-(\d\.\d\d)$/) { + $ver2autoconf{$1} = "$autconf_dir/bin/autoconf"; + } +} +die "No autoconf-$default_autoconf_v" unless (exists $ver2autoconf{$default_autoconf_v}); + +# parse 'configure --help' to get all available options. +chomp(my @configures = `find $src_dir -name configure`) or die "$!"; + +foreach my $conf (@configures) { + my $rdir = get_rdir($conf, $src_dir); + # Fill %autoconf2util + my $conf_ac = get_configure_fname($rdir); + if (defined $conf_ac) { + my $autoconf = get_autoconf("$src_dir/$conf_ac", "-I $src_dir -I $src_dir/$rdir"); + $autoconf2util{$rdir}{'conf_ac'} = $conf_ac; + $autoconf2util{$rdir}{'autoconf'} = $autoconf; + } else { + warn "WARNING: configure undefined for path $rdir\n"; + } + + if ($auto_variables_check) { + get_auto_variables($rdir); + } + + # No need try to execute, because it have a specific environment for launching + next unless -x $conf; + my $cmd = "CONFIGURE_DUMPER_OUT=\"/dev/null\" $conf --help"; + open (my $fh, '-|', "$cmd") or die "$!"; + + my $help; + my $prev_opt; + my $getting_help = 0; + while (my $line = <$fh>) { + chomp $line; + $line = handle_exeptions($line); + if ($line =~ /^\s*(--(\w+(-\w+)*))/) { + my $opt_var = $2; + next if ($opt_var =~ /^$ignore$/); + + if (defined $prev_opt) { + $help =~ s/\s+|\t/ /g; + $help =~ s/^\s+//g; + $src_path2help{$rdir}{$prev_opt} = $help; + } + + $help = $line; + $getting_help = 1; + chomp $help; + + $opt_var =~ s/-/_/g; + $prev_opt = $opt_var; + $src_path2option{$rdir}{$opt_var}++; + next unless $enable_opp; + + foreach my $pref (keys %prefix2opp) { + if ($opt_var =~ /^($pref)_/) { + $opt_var =~ s/$pref/$prefix2opp{$pref}/; + $src_path2option{$rdir}{$opt_var}++; + last; + } + } + } elsif ($getting_help && $line =~ /^\s+[^\s]+/) { + chomp $line; + $help .= $line; + } else { + $getting_help = 0; + } + } + if (defined $prev_opt) { + $help =~ s/\s+|\t/ /g; + $help =~ s/^\s+//g; + $src_path2help{$rdir}{$prev_opt} = $help; + } + close($fh); + + if ($alternatives_check) { + parse_opt_alternatives($rdir, \%{$src_path2option{$rdir}}); + } +} + +# generate help in terms of opposite options +my %src_path2opphelp; +foreach my $path (keys %src_path2help) { + foreach my $opt (keys %{$src_path2help{$path}}) { + foreach my $pref ('disable', 'without') { + if ($opt =~ /^$pref/) { + my $opp_opt = $opt; + $opp_opt =~ s/$pref/$prefix2opp{$pref}/; + next if (exists $src_path2help{$path}{$opp_opt}); + + my $help = $src_path2help{$path}{$opt}; + $src_path2opphelp{$path}{$opp_opt} = "OPPOSITE: $help"; + } + } + } +} + +foreach my $path (keys %src_path2opphelp) { + foreach my $opp_opt (keys %{$src_path2opphelp{$path}}) { + $src_path2help{$path}{$opp_opt} = $src_path2opphelp{$path}{$opp_opt}; + } +} + +chomp(my @dumps = `find $build_dir -name $dump_fname`) or die "$!"; + +# The dump file may content dump from several configures +my @path_stack; +my @paths; + +sub init_help_for_build { + my ($path, $dump_path) = @_; + die "Not defined path or dump_path\n" unless (defined $path && defined $dump_path); + # print("Init for $path\n"); + foreach my $opt (sort keys %{$src_path2option{$path}}) { + unless (defined $build_path2option{$dump_path}{$opt}) { + $build_path2option{$dump_path}{$opt} = { + 'h' => $src_path2help{$path}{$opt} + }; + } + } +} + +foreach my $dump (@dumps) { + open(my $fh, '<', $dump) or die "Couldn't open $dump: $!"; + my $line_num = 0; + my $path; + + my $dump_path = get_rdir($dump, $build_dir); + + while (my $line = <$fh>) { + $line_num++; + chomp $line; + + if ($line =~ /^\# /) { + if ($line =~ /^\Q$BEGIN_DUMP_STR\E/) { + $line =~ s/^\Q$BEGIN_DUMP_STR\E //; + unless ($line =~ /\s/ || $line eq '') { + push(@path_stack, $path) if (defined $path); + $path = $line; + push(@paths, $path) unless (grep { $_ eq $path } @paths); + # print "SET $path ($dump:$line_num)\n"; + init_help_for_build($path, $dump_path); + } else { + warn "WARNING: BEGIN_DUMP_STR found, but path is not defined ($dump:$line_num)\n"; + } + } elsif ($line =~ /^\Q$END_DUMP_STR\E/) { + $line =~ s/^\Q$END_DUMP_STR\E //; + if (defined $line) { + warn "WARNING: END_DUMP_STR found, but path is not defined ($dump:$line_num)\n" if ($line =~ /\s/ || $line eq ''); + warn "WARNING: END_DUMP_STR found, but paths are not equvivalent: dump read '$line', path '$path' ($dump:$line_num)\n" unless ($line eq $path); + } + my $path_pop = pop(@path_stack); + $path = $path_pop; + if (defined $path) { + # print "SET $path ($dump:$line_num)\n"; + push(@paths, $path) unless (grep { $_ eq $path } @paths); + } + # print "UNSET \$path ($dump:$line_num)\n" unless (defined $path); + } + next; + } + unless (defined $path) { + print "Skip ($dump:$line_num)\n"; + next; + } + my @check_opts; + + # checking manual rules. + foreach my $opt (keys %{$transl_rules->{$path}}) { + my $man_opt_ = $transl_rules->{$path}->{$opt}; + if ($man_opt_ =~ /^[+\-]?(\w*)$/) { + my $man_opt = $1; + next if ($man_opt =~ /^$/); + + if ($line =~ /^$man_opt=(.*)/) { + $build_path2option{$dump_path}{$opt}->{'v'} = $1; + } + } else { + die "Wrong format of a translation rule: \'$man_opt_\'\n"; + } + } + + foreach my $opt (keys %{$src_path2option{$path}}) { + next if (exists $build_path2option{$dump_path}{$opt}->{'v'}); + + my $man_opt_ = $transl_rules->{$path}->{$opt}; + next if ((defined $man_opt_) && ($man_opt_ =~ /^[+\-]?(\w+)$/)); + + if ($line =~ /^$opt=(.*)/) { + $build_path2option{$dump_path}{$opt}->{'v'} = $1; + } elsif ($alternatives_check) { + foreach my $alt_opt (keys %{$option2alternatives{$path}{$opt}}) { + if ($line =~ /^$alt_opt=(.*)/) { + $build_path2option{$dump_path}{$opt}->{'v'} = $1; + last; + } + } + } + } + next unless ($auto_variables_check); + foreach my $opt (keys %{$build_path2variable{$path}}) { + if ($line =~ /^$opt=(.*)/) { + if ( catfile($src_dir, $dump_path) eq catfile($src_dir, $path) ) { + # name of build subdirectory equvivalent name of source directory + if (defined $build_path2variable{$path}{$opt}{'value'}) { + warn "WARNING: $path -> $opt already defined ($dump:$line_num) = \"$build_path2variable{$path}{$opt}{'value'}\"\nread from file \"$line\"\n"; + } + } else { + # add the build path - extend the option name + $opt .= "($dump_path)"; + if (defined $build_path2variable{$path}{$opt}{'value'}) { + warn "WARNING: $path -> $opt already defined ($dump:$line_num) = \"$build_path2variable{$path}{$opt}{'value'}\"\nread from file \"$line\"\n"; + } + } + # always use the last value + $build_path2variable{$path}{$opt}{'value'} = $1; + last; + } + } + } + close $fh; + + # set up default values for all paths + foreach $path (@paths) { + foreach my $opt (keys %{$transl_rules->{$path}}) { + #next unless (exists $src_path2option{$path}{$opt}); + next if (exists $build_path2option{$dump_path}{$opt}->{'v'}); + + my $man_opt_ = $transl_rules->{$path}->{$opt}; + my $sign = ''; + $sign = $1 if ($man_opt_ =~ /^([+\-])/); + my $default_val = undef; + if ($sign eq '+') { + $default_val = 'yes'; + } elsif ($sign eq '-') { + $default_val = 'no'; + } + if (defined $default_val) { + $build_path2option{$dump_path}{$opt}->{'v'} = $default_val; + } + } + } +} + +unlink $out_db; +my $dbh = connect_db($out_db); +create_db_table($dbh); + +foreach my $path (sort keys %build_path2option) { + print "$path\n"; + foreach my $opt (sort keys %{$build_path2option{$path}}) { + if ($ignore_neg_opts) { + next if ($opt =~ /(without|disable)/); + } + my $val = $build_path2option{$path}{$opt}->{'v'}; + my $help = $build_path2option{$path}{$opt}->{'h'}; + $val = $UNDEFINED_VALUE unless (defined $val); + unless (defined $help) { + $help = $special_help->{$path}->{$opt}; + unless (defined $help) { + $help = ''; + warn "WARNING: $path:$opt - help message is undefined\n"; + } + } + chomp $help; + print "\t$opt:$val|:::|$help\n"; + insert_db_row($dbh, $path, $opt, $val, $help); + } + + next unless ($auto_variables_check); + foreach my $opt (sort keys %{$build_path2variable{$path}}) { + my $value = $build_path2variable{$path}{$opt}{'value'}; + unless (defined $value) { + # print("$path -> $opt is undefined\n"); + next; + } + my $help = $build_path2variable{$path}{$opt}{'help'}; + unless (defined $help) { + if ($opt =~ /(.*)\(.*\)$/ ) { + # use help description for extended name of variable + my $lopt = $opt; + $lopt =~ s/(.*)\(.*\)$/$1/; + $help = $build_path2variable{$path}{$lopt}{'help'}; + $help = '' unless (defined $help); + } + } + chomp $help; + print "\t$opt:$value|:::|$help\n"; + insert_db_row($dbh, $path, $opt, $value, $help); + } +} + +$dbh->disconnect(); |