path: root/validate-manifest.pl

#!/usr/bin/perl

use Digest::MD5 qw(md5_hex);
use Digest::SHA qw(sha1_hex);
use warnings;
use strict;

my ($opt_online, $opt_quiet, $opt_release, $opt_output_normalized);
my ($opt_verbose);
my (@file_args);

# default to online checking of md5sums in .asc files, but don't download
# full tarballs to check
$opt_online = 1;

while (@ARGV)
{
    my $opt = $ARGV[0];
    if ($opt eq "--online") { shift; $opt_online = 1; next; }
    if ($opt eq "--online-full") { shift; $opt_online = 2; next; }
    if ($opt =~ /^--no[_-]?online$/) { shift; $opt_online = 0; next; }
    if ($opt eq "--quiet") { shift; $opt_quiet = 1; next; }
    if ($opt eq "--verbose") { shift; $opt_verbose = 1; next; }
    if ($opt eq "--release") { shift; $opt_release = 1; next; }
    if ($opt =~ /^--output-normalized(=(.*))?$/) { shift; $opt_output_normalized = $2 // shift; next; }
    if ($opt =~ /^--/) { die "Unrecognised option $opt"; }
    # Other arguments are manifest files for validation.
    push @file_args, shift;
}

die "Syntax..." unless $#file_args > -1;

if (defined $opt_output_normalized && $#file_args  != 0)
{
   die "Must have exactly one input file when using --output-normalized"; 
}

sub parse_manifest
{
    my ($mfile) = @_;
    my $res;

    open MFILE,"<$mfile" or die "Could not open $mfile: $!";

    # parser states...
    #   0: at first line, expecting manifest_format=
    #   1: base state, not in component info stanza
    #   2: waiting for more component info
    #   3: in the developer info section
    my $state = 0;
    ### $line == $res->{ctx}{line};
    $res->{ctx}{line_no} = 0;
    $res->{ctx}{errors} = 0;
    $res->{ctx}{filename} = $mfile;
    my $cur_component;
    my $line;
    while ($line = <MFILE>)
    {
        chomp $line;
        $res->{ctx}{line} = $line; # used for error reporting
        $res->{ctx}{line_no}++;

        if ($state == 0)
        {
            if ($line=~/^manifest_format=(.*)$/)
            {
                $res->{mani_ver} = $1;
            } else {
                # if we don't know the manifest version, then default to 1.1
                $res->{mani_ver} = "1.1";
                error ($res, "manifest version line not present")
            }
            $state=1;
            next;
        }
        if ($state == 1 && $line=~/^# Note that for ABE, these parameters are not used/)
        {
            # technically, this line appears exactly once at line 3, but we just
            # ignore this line any time it appears in state 1;
            next;
        }
        if ($state == 1 && $line=~/^([a-z]+)=(.*)/)
        {
            if (defined $res->{flag_info}{$1})
            {
                error ($res, "duplicate flag")
            }
            $res->{flag_info}{$1} = $2;
            next;
        }
        if ($state == 2 && $line=~/^([a-z]+)_([0-9a-z_]+)=(.*)/)
        {
            if (defined $res->{component_info}{$1}{$2})
            {
                error ($res, "duplicate definition")
            }
            if ($1 ne $cur_component)
            {
                error ($res, "found component info for wrong component, expected $cur_component")
            }
            $res->{component_info}{$1}{$2} = $3;
            next;
        }
        if ($state == 1 && $line=~/^ #*$/)
        {
            # OK
            next;
        }
        if ($state == 1 && $line=~/^ # Everything below this line is only for informational purposes for developers$/)
        {
            $state = 3;
            next;
        }
        if ($state <= 2 && $line=~/^$/)
        {
            # empty line marks end of component info section
            undef $cur_component;
            $state = 1;
            next;
        }
        if ($state == 1 && $line=~/^# Component data for (.*)/)
        {
            # expect a comment which introduces the component info
            $cur_component = "$1";
            $state = 2;
            next;
        }

        if ($state == 3 && $line=~/^([a-z]+)_([a-z]+)=(.*)/)
        {
            if (defined $res->{component_info}{$1})
            {
                error ($res, "duplicate component info in developer info section")
            }
            next;
        }
        if ($state == 1 || $state == 2)
        {
            error ($res, "unexpected line");
            next;
        }
    }

    # parsing has finished, so we don't want error() to report line
    # numbers.
    undef $res->{ctx}{line};
    undef $res->{ctx}{line_no};

    if ($state != 3)
    {
        error($res, "didn't find developer info section");
    }
    close MFILE;
    return $res;
}

my $exit_status = 0;

foreach my $file (@file_args)
{
    my $manifest = parse_manifest($file);
    die ("manifest parsing of $file failed") unless defined $manifest;

    check_manifest_version($manifest);
    check_components_list($manifest);
    check_all_flags($manifest);
    check_all_components($manifest);
    check_url_locations($manifest) if $opt_release;
    check_gdbserver($manifest);
    check_manifestid($manifest);
    check_online($manifest) if $opt_online;
    output_normalized($manifest, $opt_output_normalized) if $opt_output_normalized;

    # indicate success in exit code.
    if ($manifest->{ctx}{errors} > 0)
    {
        $exit_status = 1;
    } else {
        my $fn = $manifest->{ctx}{filename};
        print STDERR "PASS: $fn\n" if $opt_verbose;
    }
}

exit $exit_status;

sub error
{
    my ($m, $msg) = @_;
    my $extra = "";
    if (defined $m->{ctx}{line})
    {
        my $in = $m->{ctx}{line};
        my $line_no = $m->{ctx}{line_no};
        $extra= "  at line $line_no: $in\n";
    }
    my $fn = $m->{ctx}{filename};
    $m->{ctx}{errors}++;
    print STDERR "ERROR: $fn: $msg\n$extra" if !$opt_quiet;
}

sub check_all_components
{
    my ($m) = @_;
    foreach my $component (keys %{$m->{component_info}})
    {
        check_component ($m, $component)
    }
}


sub check_url_locations
{
    my ($m) = @_;
    my @valid_urls=(
    "http://snapshots.linaro.org/components/toolchain/infrastructure",
    "http://git.linaro.org/git/toolchain",
    "http://releases.linaro.org/components/toolchain"
    );
    foreach my $component (keys %{$m->{component_info}})
    {
        my $url = $m->{component_info}{$component}{url};
        next unless defined $url;
        my $valid = 0;
        foreach my $url_prefix (@valid_urls)
        {
            my $re = quotemeta($url_prefix);
            $valid = 1 if $url=~/^$re\b/;
        }
        error($m, "Component $component has unexpected url: $url") unless $valid;
    }
}

sub fields_for_component
{
    my ($m, $component) = @_;
    # hash keyed by field name, value is 0 for optional, 1 for required.
    my %fields = ();
    $fields{url} = 1;
    $fields{filespec} = 1;
    $fields{makeflags} = 0;
    if ($component !~ /^(linux|dejagnu|expat|python)$/)
    {
        $fields{configure} = 1;
    }
    if ($component !~ /^e?glibc$/)
    {
        $fields{staticlink} = 1;
    }
    if ($component eq "gcc")
    {
        $fields{stage1_flags} = 1;
        $fields{stage2_flags} = 1;
    }
    my $filespec = $m->{component_info}{$component}{filespec};
    if (!defined $filespec || $filespec=~/\.tar\..z$/)
    {
        # md5sum field was introduced in version 1.2
        $fields{md5sum} = 1 if version_ge($m, "1.2");
    } else {
        $fields{revision} = 1;
        $fields{branch} = 1;
    }
    $fields{mingw_only} = 1 if version_ge($m, "1.4");
    $fields{mingw_extraconf} = 0 if version_ge($m, "1.4");
    return %fields;
}

sub check_component
{
    my ($m, $component) = @_;
    my %fields = fields_for_component($m, $component);
    for my $field (keys %{$m->{component_info}{$component}})
    {
        if (!defined $fields{$field})
        {
            error($m, "unexpected parameter ${component}_${field}")
        }
    }
    for my $field (keys %fields)
    {
        if ($fields{$field} && !defined $m->{component_info}{$component}{$field})
        {
            error($m, "missing parameter ${component}_${field}")
        }
    }
    if ($component eq "gcc" && $m->{component_info}{$component}{configure} ne "")
    {
        error($m, "parameter ${component}_configure not empty")
    }
}

sub check_all_flags
{
    my ($m) = @_;
    my @required_flags=qw(target clibrary);
    my $err;

    push @required_flags,"manifestid" if version_ge($m, "1.3");

    foreach my $flag (@required_flags)
    {
        if (!defined $m->{flag_info}{$flag})
        {
            error ($m, "$flag not defined");
            $err = 1;
        }
    }
    foreach my $flag (keys %{$m->{flag_info}})
    {
        if (!grep (/^$flag$/, @required_flags))
        {
             error ($m, "unknown flag $flag");
        }
    }
    return if $err;
    my $is_glibc = $m->{flag_info}{clibrary} =~ /^e?glibc$/;
    my $is_newlib = $m->{flag_info}{clibrary} =~ /^newlib$/;
    error ($m, "invalid clibrary") if $m->{flag_info}{target}=~/linux/ && !$is_glibc;
    error ($m, "invalid clibrary") if $m->{flag_info}{target}!~/linux/ && !$is_newlib;
    if (!defined $m->{component_info}{$m->{flag_info}{clibrary}})
    {
        error ($m, "No component info for selected clibrary");
    }
}

my %asc_md5_lookup=();

sub check_md5sum_asc_url
{
    my ($m, $component, $exp_md5sum, $url, $filespec) = @_;
    my $asc_md5 = $asc_md5_lookup{$url};
    if (!defined $asc_md5)
    {
        my $asc_file = get("$url");
        if (!defined $asc_file)
        {
            error ($m, "download of $url failed");
            return;
        }
        $asc_md5 = ($asc_file =~ /^([a-f0-9]*)  $filespec/)[0];
        $asc_md5_lookup{$url}=$asc_md5;
    }
    if (!defined $asc_md5)
    {
        error ($m, "Component $component asc file $url has invalid format");
        return;
    }
    if (defined $exp_md5sum && $asc_md5 ne $exp_md5sum)
    {
        error ($m, "$component md5sum did not match asc file, $exp_md5sum/$asc_md5");
    }
}

my %full_md5_lookup;

sub check_md5sum_full_file
{
    my ($m, $component, $exp_md5sum, $url, $filespec) = @_;
    my $real_md5sum=$full_md5_lookup{$url};
    if (!defined $real_md5sum)
    {
        my $full_file = get("$url");
        if (!defined $full_file)
        {
            error ($m, "download of $url failed");
            return;
        }
        $real_md5sum = md5_hex($full_file);
        $full_md5_lookup{$url} = $real_md5sum;
    }
    if (defined $exp_md5sum && $real_md5sum ne $exp_md5sum)
    {
        error ($m, "$component md5sum did not match downloaded file, $exp_md5sum/$real_md5sum");
    }
}

sub check_online
{
    my ($m) = @_;
    use LWP::Simple;
    foreach my $component (keys %{$m->{component_info}})
    {
        my $md5sum = $m->{component_info}{$component}{md5sum};
        my $filespec = $m->{component_info}{$component}{filespec};
        my $full_url = $m->{component_info}{$component}{url} . "/" . $filespec;
        # this is how abe does it, so we mirror that here...
        next if $filespec !~ /\.tar\./;
        check_md5sum_asc_url($m, $component, $md5sum, $full_url.".asc", $filespec);
        if ($opt_online == 2)
        {
            check_md5sum_full_file($m, $component, $md5sum, $full_url, $filespec);
        }
    }
}

sub check_gdbserver
{
    my ($m) = @_;
    my @matching_fields=qw(url branch revision filespec);
    return if !defined $m->{component_info}{gdb};
    return if !defined $m->{component_info}{gdbserver};
    foreach my $field (@matching_fields)
    {
        if ((defined $m->{component_info}{gdb}{$field} !=
               defined $m->{component_info}{gdbserver}{$field})
            || (defined $m->{component_info}{gdb}{$field}
                 && ($m->{component_info}{gdb}{$field} ne
                     $m->{component_info}{gdbserver}{$field})))
        {
            error ($m, "gdb_$field does not match gdbserver_$field");
        }
    }
}

sub check_components_list
{
    my ($m) = @_;
    my @required_components = qw(gmp mpfr mpc dejagnu binutils gcc gdb);
    my @linux_target_components = qw(linux gdbserver);
    my @win32_components = qw(expat python);
    my @valid_clibs = qw(glibc newlib eglibc);

    # in version 1.4 manifests, expat and python are required
    if (version_ge($m, "1.4"))
    {
        push @required_components, @win32_components;
        @win32_components=();
    }

    if (($m->{flag_info}{target}) =~ /linux/)
    {
        push @required_components, @linux_target_components
    }

    my @clibs=();
    foreach my $comp (keys %{$m->{component_info}})
    {
        if (grep /^$comp$/, @required_components)
        {
            # that's ok!
        } elsif (grep /^$comp$/, @win32_components) {
            # that's ok!
            # we could verify that the host is mingw32 here
        } elsif (grep /^$comp$/, @valid_clibs) {
            push @clibs, $comp;
        } else {
            error ($m, "Unexpected component $comp");
        }
    }
    foreach my $comp (@required_components)
    {
        if (!defined $m->{component_info}{$comp}) {
            error ($m, "Component $comp not found.");
        }
    }

    if ($#clibs == -1)
    {
        error ($m, "No C libraries");
    } elsif ($#clibs > 0) {
        error ($m, "Too many C libraries: @clibs");
    }
}

sub check_manifest_version
{
   my ($m) = @_;
   if ($m->{mani_ver} !~ /^1\.[1234]$/)
   {
       error($m, "Unknown manifest version $m->{mani_ver}, treating as 1.4");
       $m->{mani_ver} = "1.4";
   }
}

sub version_ge
{
    my ($m, $compare) = @_;
    my ($compare_major, $compare_minor) = $compare=~/(\d+)\.(\d+)/;
    my ($major, $minor) = $m->{mani_ver}=~/(\d+)\.(\d+)/;

    if ($major > $compare_major ||
        ($major == $compare_major && $minor >= $compare_minor))
    {
        return 1;
    } else {
        return undef;
    }
}

sub calculate_manifest_id
{
    my ($m) = @_;

    # This is used to accumulate the string which will be passed to sha1_hex
    # to calculate the manifest ID.
    my $str = "";

    $str=sprintf("%s%s=%s\n", $str, "manifest_format", $m->{mani_ver});
    foreach my $comp (sort keys %{$m->{component_info}})
    {
        foreach my $field (sort keys %{$m->{component_info}{$comp}})
	{
            my $field_value = $m->{component_info}{$comp}{$field};
            $str=sprintf("%s%s_%s=%s\n", $str, $comp, $field, $field_value);
	}
    }

    foreach my $flag (sort keys %{$m->{flag_info}})
    {
        next if $flag eq "manifestid";
	$str=sprintf("%s%s=%s\n", $str, $flag, $m->{flag_info}{$flag});
    }

    return sha1_hex($str);
}

sub check_manifestid
{
    my ($m) = @_;

    my $calculated_id=calculate_manifest_id($m);
    my $real_id = $m->{flag_info}{manifestid};

    # we don't need to check the manifest id if it is not present.
    return if !defined $real_id;

    if ($calculated_id ne $real_id)
    {
	error($m, "Manifest ID mismatch. Expected $real_id, got $calculated_id.");
    }
}

sub output_normalized
{
    my ($m, $outfile) = @_;

    open OUT,">$outfile" or die "Could not open $outfile: $!";

    printf(OUT "manifest_format=%s\n\n", $m->{mani_ver});
    printf(OUT "# Note that for ABE, these parameters are not used\n");

    foreach my $comp (sort keys %{$m->{component_info}})
    {
	printf(OUT "# Component data for %s\n", $comp);
        foreach my $field (sort keys %{$m->{component_info}{$comp}})
	{
            my $field_value = $m->{component_info}{$comp}{$field};
	    printf(OUT "%s_%s=%s\n", $comp, $field, $field_value);
	}
	printf(OUT "\n");
    }

    printf(OUT "\n");

    foreach my $flag (sort keys %{$m->{flag_info}})
    {
	printf(OUT "%s=%s\n", $flag, $m->{flag_info}{$flag});
    }

print OUT <<EOF;

 ##############################################################################
 # Everything below this line is only for informational purposes for developers
 ##############################################################################
EOF

    close OUT;
}