#!/usr/bin/perl

####################
#    Copyright (C) 2012 Niels Thykier <niels@thykier.net>
#     - Based on a shell script by Raphael Geissert <atomo64@gmail.com>
#
#    This file is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 2 of the License, or
#    (at your option) any later version.
#
#    This file is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this file.  If not, see <http://www.gnu.org/licenses/>.
####################

use strict;
use warnings;
use autodie;

use File::Temp qw(tempfile);
use POSIX qw (strftime);

BEGIN {
    $ENV{'LINTIAN_ROOT'} //= '.';
}

use lib "$ENV{'LINTIAN_ROOT'}/lib/";
use Lintian::Command qw(safe_qx);
use Lintian::Deb822Parser qw(parse_dpkg_control);

my $datapath = shift;
my %hardening = (
    fortify         => 'if-enabled',
    relro           => 'if-enabled',
    stackprotector  => 'if-enabled',
    bindnow         => 'always',
    pie             => 'always',
);
my (%archs, %files);

# Adding data files to be updated by this file is as simple as calling
# add_data_file and give it a hash of the following:
#
# filename => name of the data file in the data dir
# line-spec => List-ref of line descriptions.  Variables from
#              dpkg-architecture can be used via @VAR@.  There will be
#              one line in the list-ref times the architectures listed
#              by $(dpkg-architecture -L).
# header => Optional text header text.  Lines should start with "#".
#           The script will add the "Last updated", "With" and a
#           "This file was auto-generated by $0" automatically.
# keep =>   If present and a truth value, the file will use
#           "keep:" comments to hard-code some values
#
#
# All lines (except the header) will be sorted before they are written
# to minimize the diff.
#

add_data_file(
    'filename' => 'common/multiarch-dirs',
    'line-spec' => ['@DEB_HOST_ARCH@ @DEB_HOST_MULTIARCH@'],
    'header'  => <<EOF
# List of "Multiarch dirs" relationships as provided by
# dpkg-architecture - arch -> dir mapping
EOF
);

add_data_file(
    'filename' => 'files/triplets',
    'line-spec' => ['@DEB_HOST_MULTIARCH@ @DEB_HOST_ARCH@'],
    'header' => <<EOF
# List of "triplet architecture" relationships as provided by
# dpkg-architecture'
EOF
);

add_data_file(
    'filename' => 'common/architectures',
    'line-spec' =>
      ['@DEB_HOST_ARCH@ || @DEB_HOST_ARCH_OS@ @DEB_HOST_ARCH_CPU@'],
    'header' => <<EOF
# List of known architectures as provided by dpkg-architecture
# (excluding "all" and "any", which are handled specially)
EOF
);

add_data_file(
    'filename' => 'shared-libs/ldconfig-dirs',
    'line-spec' => ['lib/@DEB_HOST_MULTIARCH@','usr/lib/@DEB_HOST_MULTIARCH@'],
    'keep' => 1,
    'header' => <<EOF
# The list of directories searched by default by the dynamic linker.
# Packages installing shared libraries into these directories must call
# ldconfig, must have shlibs files, and must ensure those libraries have
# proper SONAMEs.
#
# Directories listed here must not have leading slashes.
#
# On the topic of multi-arch dirs.  Hopefully including the ones not
# native to the local platform won't hurt.
#
# See Bug#469301 and Bug#464796 for more details.
#
EOF
);

add_data_file(
    'filename' => 'binaries/hardening-tags',
    'line-spec' => ['@DEB_HOST_ARCH@ || @HARDENING@'],
    'header' => <<EOF
# Map of architectures to enabled hardening tags.
#
# NB: Keep this in sync with checks/binaries.desc
EOF
);

unless ($datapath) {
    print STDERR "Usage: $0 path/to/lintian/data\n";
    exit 1;
}

$ENV{'LC_ALL'} = 'C';

my $dver = safe_qx([qw(dpkg-architecture --version)], '|', [qw(head -n1)]);
chomp $dver;

open(my $dlfd, '-|', 'dpkg-architecture', '-L');
while (my $archstr = <$dlfd>) {
    my (@hardening, %htags, %enabled_default);
    delete $ENV{'DEB_HOST_ARCH'};
    chomp $archstr;
    open(my $dafd, '-|', 'dpkg-architecture', "-a$archstr");
    while (my $var = <$dafd>) {
        chomp $var;
        my ($key, $value) = split /=/, $var, 2;
        $archs{$archstr}{$key} = $value;
    }
    close($dafd);
    $ENV{'DEB_HOST_ARCH'} = $archstr;
    delete($ENV{'DEB_BUILD_MAINT_OPTIONS'});
    open(my $dbfd, '-|', 'dpkg-buildflags', '--query-features', 'hardening');
    @hardening = parse_dpkg_control($dbfd);
    close($dbfd);
    # First, find all hardening features enabled by default on this
    # architecture.
    foreach my $paragraph (@hardening) {
        my $tag = 'hardening-no-' . $paragraph->{'feature'};
        next if not exists $hardening{$paragraph->{'feature'}};
        $tag = 'hardening-no-fortify-functions'
          if $tag eq 'hardening-no-fortify';
        if (($paragraph->{'enabled'}//'no') eq 'yes') {
            $enabled_default{$tag} = 1;
        }
    }

    $ENV{'DEB_BUILD_MAINT_OPTIONS'} = 'hardening=+all';
    open($dbfd, '-|', 'dpkg-buildflags', '--query-features', 'hardening');
    @hardening = parse_dpkg_control($dbfd);
    close($dbfd);
    # Now scan over all hardening features for this architecture.
    foreach my $paragraph (@hardening) {
        my $tag = 'hardening-no-' . $paragraph->{'feature'};
        next if not exists $hardening{$paragraph->{'feature'}};
        $tag = 'hardening-no-fortify-functions'
          if $tag eq 'hardening-no-fortify';
        if (($paragraph->{'enabled'}//'no') eq 'yes') {
            # It is available on the architecture - add it if it is
            # enabled by default or we flagged it as "always".
            $htags{$tag} = 1
              if $enabled_default{$tag}
              or $hardening{$paragraph->{'feature'}} eq 'always';
        }
    }
    $archs{$archstr}{'HARDENING'} = join(', ', sort(keys(%htags)));
}
close($dlfd);

open_data_files($dver);
foreach my $archstr (sort keys %archs) {
    my $arch = $archs{$archstr};
    write_data_line($arch);
}

close_and_rename();

exit 0;

sub write_data_line {
    my ($vars) = @_;
    foreach my $filename (keys %files) {
        my $fd = $files{$filename}{'fd'};
        foreach my $orig (@{ $files{$filename}{'line-spec'} }) {
            my $line = $orig; # copy the template
            $line =~ s#\@([^@ \t]+)\@#$vars->{$1}//die "Unknown var: $1"#eg;
            push @{ $files{$filename}{'lines'} }, $line;
        }
    }
    return;
}

sub open_data_files {
    my ($version) = @_;
    my $date = strftime '%Y-%m-%d', gmtime;
    foreach my $filename (keys %files) {
        my ($fd, $temp) = tempfile();
        $files{$filename}{'temp-file'} = $temp;
        $files{$filename}{'fd'} = $fd;
        $files{$filename}{'lines'} = [];
        if ($files{$filename}{'header'}) {
            print $fd $files{$filename}{'header'};
        }
        print $fd "# Last updated: $date\n";
        print $fd "# With: $version\n";
        print $fd "# This file was auto-generated by $0\n";
        if ($files{$filename}{'keep'}) {
            open(my $orig, '<', "$datapath/$filename");
            print $fd "#\n# Lines to always be included\n";
            while (my $line = <$orig>) {
                next unless $line =~ m/^#\s*Keep:\s*(.*\S)\s*$/io;
                my $v = $1;
                print $fd "# Keep: $v\n";
                push @{ $files{$filename}{'lines'} }, $v;
            }
            close($orig);
        }
        print $fd "\n";
    }
    return;
}

sub add_data_file {
    my (%data) = @_;
    my $file = $data{'filename'} or die "Missing filename.\n";
    @{ $data{'line-spec'} } or die "Missing line spec for $file.\n";
    $data{'header'} //= '';
    $data{'keep'} //= 0;
    $files{$file} = \%data;
    return;
}

sub close_and_rename {
    foreach my $filename (keys %files) {
        my $tf = $files{$filename}{'temp-file'};
        my $fd = $files{$filename}{'fd'};
        foreach my $line (sort @{ $files{$filename}{'lines'} }) {
            print $fd "$line\n";
        }
        close($files{$filename}{'fd'});
    }
    foreach my $filename (keys %files) {
        my $tf = $files{$filename}{'temp-file'};
        my $df = "$datapath/$filename";
        system('mv', '-f', $tf, $df) == 0 or die "mv -f $tf $df failed.\n";
    }
    return;
}

# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
# End:
# vim: syntax=perl sw=4 sts=4 sr et
