#!/usr/bin/perl
#
# Copyright (c) International Business Machines Corp., 2006
#
# This program 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 program 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 program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#

#
# mkpfi
#
# This perl program is assembles PFI files from a config file.
#
# Author: Oliver Lohmann (oliloh@de.ibm.com)
#
use warnings;
use strict;
use lib "/usr/lib/perl5"; # Please change this path as you need it, or
                          # make a proposal how this could be done
                          # nicer.
use Getopt::Long;
use Pod::Usage;
use Config::IniFiles;
use File::Temp;

# ----------------------------------------------------------------------------
# Versions
our $version : unique = "0.1";
our $pfi_version : unique = "0x1";

# ----------------------------------------------------------------------------
# Globals
my $verbose = 0;
my $cfg;

my $err_prefix  = "mkpfi error";

my %opts = ();
my %files = (config => "");
my @tmp_files;

my %tools = (ubicrc32 => "ubicrc32");

# ----------------------------------------------------------------------------
# Processing the input sections
#
# The idea is to combine each section entry with a function
# in order to allow some kind of preprocessing for the values
# before they are written into the PFI file.
# This is especially useful to be more verbose and
# user-friendly in the layout file.
#
# All key-function hashes are applied after the general
# validation of the configuration file.
# If any mandatory key is missing in a section the user
# will be informed and the PFI creation process is aborted.
#
# Default keys will be checked for their presence inside the config
# file. If they are missing, they will be generated with appr. values.

# Mandatory keys for UBI volumes.
my %ubi_keys = ("ubi_ids"       => \&check_id_list,
                "ubi_size"      => \&replace_num,
                "ubi_type"      => \&replace_type,
                "ubi_names"     => \&remove_spaces,
                "ubi_alignment" => \&replace_num);

# Mandatory keys for RAW sections.
my %raw_keys = ("raw_starts"     => \&expand_starts,
                "raw_total_size" => \&replace_num);

# Common default keys for documentation and control purposes.
my %common_keys = ("flags" => \&replace_num,
                   "label" => \&do_nothing);

# Define any defaults here. Values which maintained in this default
# region need not to be specified by the user explicitly.
my %def_ubi_keys      = ("ubi_alignment" => [\&set_default, "0x1"]);
my %def_raw_keys      = ();
my %def_common_keys   = ("flags"         => [\&set_default, "0x0"],
                         "label"         => [\&generate_label, ""]);

# ----------------------------------------------------------------------------
# Input keys, actually the path to the input data.

my %input_keys = ("image" => \&do_nothing);

# Placeholder keys allow the replacement via a special
# purpose function. E.g. the bootenv_file key will be used
# to generate bootenv binary data from an text file and
# replace the bootenv_file key with an image key to handle it
# in the same way in the further creation process.
my %input_placeholder_keys = ("bootenv_file" => \&create_bootenv_image);

# ----------------------------------------------------------------------------
# Helper

# @brief Get current time string.
sub get_date {
	my $tmp = scalar localtime;
	$tmp =~ s/ /_/g;
	return $tmp;
}

# @brief Print an info message to stdout.
sub infomsg($) {
	my $str = shift;

	print "mkpfi: $str\n" if $verbose;
}

# @brief Print an error message to stderr.
sub errmsg($) {
	my $str = shift;
	print STDERR "$err_prefix: $str\n";
}

# @brief Print a warning message to stderr.
sub warnmsg($) {
	my $str = shift;
	print STDERR "mkpfi warning: $str\n";
}

sub parse_command_line($) {
	my $opt = shift;
	my $result = GetOptions( "help"	    => \$$opt{'help'},
				 "man"	    => \$$opt{'man'},
				 "verbose"  => \$$opt{'verbose'},
				 "config=s" => \$$opt{'config'},
			       ) or pod2usage(2);
	pod2usage(1) if defined ($$opt{help});
	pod2usage(-verbose => 2) if defined ($$opt{man});

	$verbose = $$opt{verbose} if defined $$opt{verbose};

	if (!defined $$opt{config}) {
		errmsg("no config file specified (use --help)");
		exit 1;
	}
}

# @brief Check if all needed tools are in PATH.
sub check_tools {
	my $err = 0;
	my $key;

	foreach $key (keys %tools) {
		if (`which $tools{$key}` eq "") {
			errmsg("\"$tools{$key}\" not found, add it to your path");
			$err = 1;
		}
	}
	die "$err_prefix: cannot not find all needed tools\n" if $err;
}

sub open_cfg_file($) {
	my $fname = shift;
	my $res = new Config::IniFiles(-file => $fname);

	die "$err_prefix: cannot load config file \"$fname\"\n" if (!defined $res);
	return $res;
}

sub set_default($$$$) {
	my ($cfg, $section, $parameter, $def_value) = @_;
	$cfg->newval($section, $parameter, $def_value);
	return;
}

sub generate_label($$$$) {
	my ($cfg, $section, $parameter, $def_value) = @_;
	my $new_label = $def_value . $section;
	$new_label .= "_" . get_date;
	$cfg->newval($section, $parameter, $new_label);
	return;
}

# @brief   Converts any num to a unified hex string, i.e the resulting value
#	   always starts with "0x" and is aligned to 8 hexdigits.
# @return  Returns 0 on success, otherwise an error occured.
#
sub any_num_to_hex($$) {
	my $val = shift;
	my $res = shift;

	# M(iB)
	if ($val =~ m/([0-9]+)[Mm][i]?[Bb]?/g) {
		$$res = sprintf("0x%08x", $1 * 1024 * 1024);
	}
	# k(iB)
	elsif ($val =~ m/([0-9]+)[kK][i]?[Bb]?/g) {
		$$res = sprintf("0x%08x", $1 * 1024);
	}
	# hex
	elsif ($val =~ m/0x?([0-9a-fA-F]+)/g) {
		$$res = sprintf("0x%08x", hex $1);
	}
	# decimal
	elsif ($val =~ m/^([0-9]+)$/g) {
		$$res = sprintf("0x%08x", $1);
	}
	else {
		$$res = "";
		return -1;
	}

	return 0;
}

sub remove_spaces($$$) {
	my ($cfg, $section, $parameter) = @_;
	my ($start, @starts, @new_starts);
	my $val = $cfg->val($section, $parameter);
	my $res;

	$val =~ s/ //g; # spaces
	$cfg->newval($section, $parameter, $val);
}

sub expand_starts($$$) {
	my ($cfg, $section, $parameter) = @_;
	my ($start, @starts, @new_starts);
	my $val = $cfg->val($section, $parameter);
	my $res;

	$val =~ s/ //g; # spaces
	@starts = split(/,/, $val);

	foreach $start (@starts) {
		if (any_num_to_hex($start, \$res) != 0) {
			errmsg("section [$section]: expecting a list of numeric " .
			       "values for parameter \"$parameter\"");
			exit 1;
		}
		push (@new_starts, $res);
	}
	$res = join(',', @starts);

	$cfg->newval($section, $parameter, $res);
}

sub check_id_list($$$) {
	my ($cfg, $section, $parameter) = @_;
	my $val = $cfg->val($section, $parameter);
	my $res;

	if (!($val =~ m/^[0-9]+[,0-9]*/)) {
		errmsg("syntax error in 'ubi_ids' in " .
		       "section \"$section\": $val");
			exit 1;
	}
}

sub replace_type($$$) {
	my ($cfg, $section, $parameter) = @_;
	my $val = $cfg->val($section, $parameter);
	my $res;

	$res = lc($val);
	grep {$res eq $_} ('static', 'dynamic')
		or die "$err_prefix: unknown UBI Volume type in section" .
		       "[$section]: $val\n";

	$cfg->newval($section, $parameter, $res);
}


sub replace_num($$$) {
	my ($cfg, $section, $parameter) = @_;
	my $val = $cfg->val($section, $parameter);
	my $res = "";

	if (any_num_to_hex($val, \$res) != 0) {
		errmsg("section [$section]: expecting a numeric value " .
		       "for parameter: $parameter");
		exit 1;
	}
	$cfg->newval($section, $parameter, $res);
}

sub do_nothing($$$) {
	my ($cfg, $section, $parameter) = @_;
	return;
}

sub bootenv_sanity_check($) {
	my $env = shift;	# hash array containing bootenv
	my %pdd = ();

	defined($$env{'pdd'}) or return "'pdd' not defined";
	foreach (split /,/, $$env{'pdd'}) {
		defined($$env{$_}) or return "undefined '$_' in pdd";
		$pdd{$_} = 1;
	}

	defined $$env{'pdd_preserve'} or
		return "";
	foreach (split /,/, $$env{'pdd_preserve'}) {
		defined($pdd{$_})
			or return "pdd_preserve field '$_' not in pdd";
	}
	return "";
}

sub create_bootenv_image($$$) {
	my ($cfg, $section, $parameter) = @_;
	my $txt_fn = $cfg->val($section, "bootenv_file");
	my $in;

	my %value = ();
	my @key = ();

	open $in, "<", $txt_fn
		or die "$err_prefix: can't open bootenv file '$txt_fn'.\n";
	while (<$in>) {
		next if (/^\s*(\#.*)?$/); # Skip comments/whitespace.

		if (/^(\S+?)\+\=(.*)$/) {
			defined($value{$1}) or
				die "$err_prefix: $txt_fn:$.: appending to" .
				    " non-existent '$1'\n";
			$value{$1} .= $2;
		} elsif (/^(\S+?)\=(.*)$/) {
			not defined($value{$1}) or
				die "$err_prefix: $txt_fn:$.: trying to" .
				     " redefine '$1'\n";
			push @key, $1;
			$value{$1} = $2;
		} else {
			die "$err_prefix: $txt_fn:$.: unrecognized syntax\n";
		}
	}
	close $in;

	$_ = &bootenv_sanity_check(\%value)
		and die "$err_prefix: $txt_fn: $_\n";

	my $tmp_file = new File::Temp();
	push (@tmp_files, $tmp_file);

	foreach (@key) {
		print $tmp_file "$_=", $value{$_}, "\0";
	}
	close $tmp_file;

	$cfg->newval($section, "image", $tmp_file-> filename);
}

sub process_keys($$$) {
	my ($cfg, $section, $keys) = @_;
	my @parameters = $cfg->Parameters($section);
	my $i;

	for ($i = 0 ; $i < scalar(@parameters) ; $i++ ) {
		if (defined($$keys{$parameters[$i]})) {
			$$keys{$parameters[$i]}->($cfg, $section,
					$parameters[$i]);
		}
	}

}

sub is_in_keylist($$) {
	my ($key, $keys) = @_;
	my $i;

	for ($i = 0; $i < scalar(@$keys); $i++) {
		if ($$keys[$i] eq $key) {
			return 1;
		}
	}

	return 0;
}

sub check_default_keys($$$) {
	my ($cfg, $section, $keys) = @_;
	my @parameters = $cfg->Parameters($section);
	my $key;

	foreach $key (keys %$keys) {
		if (!is_in_keylist($key, \@parameters)) {
			$$keys{$key}[0]->
				($cfg, $section, $key, $$keys{$key}[1]);
		}
	}

}



sub check_keys($$$) {
	my ($cfg, $section, $keys) = @_;
	my @parameters = $cfg->Parameters($section);
	my ($i, $key, $err);

	$err = 0;
	for ($i = 0 ; $i < scalar(@$keys) ; $i++ ) {
		if (!is_in_keylist($$keys[$i], \@parameters)) {
			errmsg("section [$section]: missing key \"$$keys[$i]\"");
			$err = 1;
		}
	}

	exit 1 if $err;
}

sub push_pfi_data($$$$$) {
	my ($cfg, $section, $pfi_infos, $keys, $mode) = @_;
	my ($tmp, $i, $hdr);

	my %pfi_info = ();
	$pfi_info{'mode'} = $mode;
	$pfi_info{'image'} = $cfg->val($section, "image");

	# Build the PFI header
	$hdr  = sprintf("PFI!\n");
	$hdr .= sprintf("version=0x%08x\n", hex $pfi_version);
	$hdr .= sprintf("mode=$mode\n");

	# Calculate the size of the binary data part
	$tmp = -s $cfg->val($section, "image");
	if (!defined $tmp) {
		errmsg("section [$section]: missing input image \"" .
		       $cfg->val($section, "image") . "\"");
		exit 1;
	}

	# Check for the image to fit into the given space
	my $quota;
	if ($mode eq 'raw') {
		$quota = oct $cfg->val($section, "raw_total_size");
	} elsif ($mode eq 'ubi') {
		$quota = oct $cfg->val($section, "ubi_size");
	}
	$tmp <= $quota
		or die "$err_prefix: image file too big: " .
		$cfg->val($section, "image") . "\n";
	$pfi_info{'size'} = $tmp;

	$hdr .= sprintf("size=0x%08x\n", $tmp);

	my $img_file = $cfg->val($section, "image");
	my $crc32 = `$tools{'ubicrc32'} $img_file 2>&1`;
	if (any_num_to_hex($crc32, \$tmp) != 0) {
		die "$err_prefix: $tools{'ubicrc32'} returned an error\n";
	}
	$hdr .= sprintf("crc=$tmp\n");

	# Process all remaining keys
	for ($i = 0; $i < scalar (@$keys); $i++) {
		if ($$keys[$i] eq "image") { # special case image input file
			if (! -e ($tmp = $cfg->val($section, "image"))) {
				errmsg("section [$section]: cannot find " .
				       "input file $tmp");
				exit 1;
			}
			next;
		}
		$hdr .= sprintf("%s=%s\n", $$keys[$i],
				$cfg->val($section, $$keys[$i]));
	}

	$hdr .= sprintf("\n"); # end marker for PFI-header

	$pfi_info{'header'} = $hdr;

	# store in the header list
	push @$pfi_infos, \%pfi_info;
}

sub process_section($$$$$$) {
	my ($cfg, $section, $pfi_infos, $custom_keys,
			$def_custom_keys, $mode) = @_;
	my @keys = (keys %common_keys, keys %$custom_keys);
	my @complete_keys = (@keys, keys %input_keys);

	# set defaults if necessary
	check_default_keys($cfg, $section, $def_custom_keys);
	check_default_keys($cfg, $section, \%def_common_keys);

	# check for placeholders...
	process_keys($cfg, $section, \%input_placeholder_keys);

	# VALIDATE layout.cfg entries
	check_keys($cfg, $section, \@complete_keys);

	# execute linked functions (if any)
	process_keys($cfg, $section, \%common_keys);
	process_keys($cfg, $section, $custom_keys);

	push_pfi_data($cfg, $section, $pfi_infos, \@keys, $mode);
}

sub get_section_info($$) {
	my ($cfg, $section) = @_;
	my @parameters = $cfg->Parameters($section);
	my ($ubi, $raw, $i, @res);

	$ubi = $raw = 0;
	for ($i = 0 ; $i < scalar(@parameters) ; $i++ ) {
		if ($parameters[$i] =~ m/ubi_/gi) {
			$ubi = 1;
			@res = (\%ubi_keys, \%def_ubi_keys, "ubi");
		}
		if ($parameters[$i] =~ m/raw_/gi) {
			$raw = 1;
			@res = (\%raw_keys, \%def_raw_keys, "raw");
		}
	}

	if (($ubi + $raw) != 1)	{ # double definition in section
		errmsg("layout error in section [$section]");
		exit 1;
	}

	return @res;
}

sub mk_target_list($$) {
	my $val = shift;
	my $tmp = shift;
	my $complete = 0;

	if ($val =~ m/\((.*)\)/g) {
		$val = $1;
		$complete = 1;
	}
	$val =~ s/ //g; # spaces

	@$tmp = split(/,/, $val);

	return $complete;
}

sub copy_bytes($$$) {
	my ($in, $out, $to_copy) = @_;

	while ($to_copy) {
		my $buf;
		my $bufsize = 1024*1024;

		$bufsize < $to_copy or $bufsize = $to_copy;
		read($in, $buf, $bufsize) == $bufsize
			or die "$err_prefix: image file shrunk during operation\n";
		print $out $buf;
		$to_copy -= $bufsize;
	}
}

sub write_target($$) {
	my ($pfi_infos, $target) = @_;
	my ($pfi_info);

	infomsg("writting target pfi file \"$target.pfi\"");
	if (-e "$target.pfi") {
		`rm -f $target.pfi`;
	}
	open(FILE, ">", "$target.pfi")
		or die "$err_prefix: cannot create output file: $target.pfi\n";
	binmode(FILE);

	# @FIXME sort by mode (first raw, then ubi)
	# Currently this ordering is based on a string comparism. :-)
	@$pfi_infos = sort {(lc $$a{'mode'}) cmp (lc $$b{'mode'})} @$pfi_infos;

	# Print all headers first
	foreach $pfi_info (@$pfi_infos) {
		print FILE $$pfi_info{'header'};
	}

	# Print the linked data sections
	print FILE "DATA\n";
	foreach $pfi_info (@$pfi_infos) {
		open(IMAGE, "<", $$pfi_info{'image'})
			or die "$err_prefix: cannot open input image: " .
			       "$$pfi_info{'image'}\n";
		binmode(IMAGE);
		&copy_bytes(\*IMAGE, \*FILE, $$pfi_info{'size'});
		close(IMAGE) or die "$err_prefix: cannot close input image: " .
				    "$$pfi_info{'image'}\n";
	}

	close(FILE) or die "$err_prefix: cannot close output file: $target.pfi\n";
}

sub process_config($) {
	my $cfg = shift;
	my @sections = $cfg->Sections;
	my ($i, $j, $keylist, $def_keylist, $mode, $tmp,
	    @tlist, $complete, @pfi_infos);

	my @parameters = $cfg->Parameters("targets") or
		die "$err_prefix: config file has no [targets] section\n";

	for ($i = 0 ; $i < scalar(@parameters) ; $i++ ) {
		infomsg("processing target \"$parameters[$i]\"");
		@pfi_infos = ();

		# get a list of subtargets
		$complete = mk_target_list($cfg->val("targets",
					$parameters[$i]), \@tlist);
		# build all subtargets
		for ($j = 0 ; $j < scalar(@tlist) ; $j++ ) {
			($keylist, $def_keylist, $mode)
				= get_section_info($cfg, $tlist[$j]);
			process_section($cfg, $tlist[$j],
					\@pfi_infos,
					$keylist, $def_keylist, $mode);
		}

		write_target(\@pfi_infos, $parameters[$i]);
	}

	infomsg("success");
}

sub clear_files() {
	# @FIXME:
	# Works implicitly and Fedora seems to have removed
	# the cleanup call. Thus for now, inactive.
	# File::Temp::cleanup();
}

require 5.008_000;		# Tested with version 5.8.0.
select STDOUT; $| = 1;		# make STDOUT output unbuffered
select STDERR; $| = 1;		# make STDERR output unbuffered

parse_command_line(\%opts);
check_tools;
$cfg = open_cfg_file($opts{config});
process_config($cfg);
clear_files;

__END__


=head1 NAME

mkpfi - Using GetOpt::Long, Pod::Usage, Config::IniFiles


=head1 SYNOPSIS

mkpfi [OPTIONS ...]


	OPTION

	[--config] [--help] [--man]


=head1 ABSTRACT

Perl script for generating pdd pfi files from given config files.

=head1 OPTIONS

=over

=item B<--help>

Print out brief help message.

=item B<--usage>

Print usage.

=item B<--config>

Config input file.

=item B<--man>

Print manual page, same as 'perldoc mkpfi'.

=item B<--verbose>

Be verbose.

=back

=head1 BUGS

Report via MTD mailing list


=head1 SEE ALSO

http://www.linux-mtd.infradead.org/


=head1 AUTHOR

Oliver Lohmann (oliloh@de.ibm.com)

=cut