mtd-utils-1.3.1/ubi-utils/old-utils/perl/mkpfi - nest-learning-thermostat/5.1.1/mtd-utils - Git at Google

 #!/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 %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 INFO($) {
 	my $str = shift;

 	if (!$verbose) {
 		return;
 	}

 	print STDOUT $str;
 }

 # @brief Print an error message to stderr.
 sub ERR($) {
 	my $str = shift;
 	print STDERR $str;
 }

 # @brief Print a warning message to stderr.
 sub WARN($) {
 	my $str = shift;
 	print STDERR $str;
 }

 sub parse_command_line($) {
 	my $opt = shift;
 	my $result = GetOptions( "help"	     => \$$opt{'help'},
 				 "man"	     => \$$opt{'man'},
 				 "config=s"  => \$$opt{'config'},
 				 "verbose"   => \$$opt{'verbose'},
 			       ) 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}) {
 		ERR("[ ERROR: No config file specified. Aborting...\n");
 		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 "") {
 			ERR("\n") if ($err == 0);
 			ERR("! Please add the tool \'$tools{$key}\' " .
 				"to your path!\n");
 			$err = 1;
 		}
 	}
 	die "[ ERROR: Did not find all needed tools!\n" if $err;
 }

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

 	die "[ ERROR: Cannot load your config file!\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) {
 			ERR("[ ERROR: [$section]\n");
 			ERR("[        Expecting a list of numeric " .
 			    "values for parameter: $parameter\n");
 			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]*/)) {
 		ERR("[ ERROR: Syntax error in 'ubi_ids' in " .
 		    "section '$section': $val\n");
 			ERR("[ Aborting... ");
 			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 "[ ERROR: 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) {
 		ERR("[ ERROR: [$section]\n");
 		ERR("[        Expecting a numeric value " .
 		    "for parameter: $parameter\n");
 		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 "[ ERROR: can't open bootenv file '$txt_fn'.\n";
 	while (<$in>) {
 		next if (/^\s*(\#.*)?$/); # Skip comments/whitespace.

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

 	$_ = &bootenv_sanity_check(\%value)
 		and die "$txt_fn: error: $_\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)) {
 			ERR("[ ERROR: [$section]\n") if $err == 0;
 			$err = 1;
 			ERR("[        Missing key '$$keys[$i]'\n");
 		}
 	}

 	if ($err) {
 		ERR("[ Aborting...\n");
 		exit 1;
 	}
 }

 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) {
 		ERR("[ ERROR: [$section]\n");
 		ERR("[        Missing input image: "
 				. $cfg->val($section, "image") . "\n");
 		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 "[ERROR: 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 "[ ERROR: $tools{'ubicrc32'} returned with errors";
 	}
 	$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"))) {
 				ERR("[ ERROR: [$section]\n");
 				ERR("[        Cannot find input file $tmp\n");
 				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
 		ERR("[ ERROR: Layout error in section '$section'\n");
 		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 "[ ERROR: Image file shrunk during operation\n";
 		print $out $buf;
 		$to_copy -= $bufsize;
 	}
 }

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

 	INFO("[ Writting target pfi file: '$target.pfi'...\n");
 	if (-e "$target.pfi") {
 		WARN("! Replaced old pfi...\n");
 		`rm -f $target.pfi`;
 	}
 	open(FILE, ">", "$target.pfi")
 		or die "[ ERROR: 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 "[ ERROR: Cannot open input image: " .
 				"$$pfi_info{'image'}" . "\n";
 		binmode(IMAGE);
 		&copy_bytes(\*IMAGE, \*FILE, $$pfi_info{'size'});
 		close(IMAGE) or die "[ ERROR: Cannot close input image: " .
 				"$$pfi_info{'image'}" . "\n";
 	}
 	close(FILE) or die "[ ERROR: 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 "[ ERROR: Config file has no 'targets' section!\n";

 	for ($i = 0 ; $i < scalar(@parameters) ; $i++ ) {
 		INFO("[ Processing target '$parameters[$i]'...\n");
 		@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]);
 	}

 	INFO("[ Success.\n");


 }

 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
	#!/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 %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 INFO($) {
	my $str = shift;

	if (!$verbose) {
	return;
	}

	print STDOUT $str;
	}

	# @brief Print an error message to stderr.
	sub ERR($) {
	my $str = shift;
	print STDERR $str;
	}

	# @brief Print a warning message to stderr.
	sub WARN($) {
	my $str = shift;
	print STDERR $str;
	}

	sub parse_command_line($) {
	my $opt = shift;
	my $result = GetOptions( "help" => \$$opt{'help'},
	"man" => \$$opt{'man'},
	"config=s" => \$$opt{'config'},
	"verbose" => \$$opt{'verbose'},
	) 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}) {
	ERR("[ ERROR: No config file specified. Aborting...\n");
	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 "") {
	ERR("\n") if ($err == 0);
	ERR("! Please add the tool \'$tools{$key}\' " .
	"to your path!\n");
	$err = 1;
	}
	}
	die "[ ERROR: Did not find all needed tools!\n" if $err;
	}

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

	die "[ ERROR: Cannot load your config file!\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) {
	ERR("[ ERROR: [$section]\n");
	ERR("[ Expecting a list of numeric " .
	"values for parameter: $parameter\n");
	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]*/)) {
	ERR("[ ERROR: Syntax error in 'ubi_ids' in " .
	"section '$section': $val\n");
	ERR("[ Aborting... ");
	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 "[ ERROR: 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) {
	ERR("[ ERROR: [$section]\n");
	ERR("[ Expecting a numeric value " .
	"for parameter: $parameter\n");
	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 "[ ERROR: can't open bootenv file '$txt_fn'.\n";
	while (<$in>) {
	next if (/^\s(\#.)?$/); # Skip comments/whitespace.

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

	$_ = &bootenv_sanity_check(\%value)
	and die "$txt_fn: error: $_\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)) {
	ERR("[ ERROR: [$section]\n") if $err == 0;
	$err = 1;
	ERR("[ Missing key '$$keys[$i]'\n");
	}
	}

	if ($err) {
	ERR("[ Aborting...\n");
	exit 1;
	}
	}

	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) {
	ERR("[ ERROR: [$section]\n");
	ERR("[ Missing input image: "
	. $cfg->val($section, "image") . "\n");
	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 "[ERROR: 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 "[ ERROR: $tools{'ubicrc32'} returned with errors";
	}
	$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"))) {
	ERR("[ ERROR: [$section]\n");
	ERR("[ Cannot find input file $tmp\n");
	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
	ERR("[ ERROR: Layout error in section '$section'\n");
	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 "[ ERROR: Image file shrunk during operation\n";
	print $out $buf;
	$to_copy -= $bufsize;
	}
	}

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

	INFO("[ Writting target pfi file: '$target.pfi'...\n");
	if (-e "$target.pfi") {
	WARN("! Replaced old pfi...\n");
	`rm -f $target.pfi`;
	}
	open(FILE, ">", "$target.pfi")
	or die "[ ERROR: 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 "[ ERROR: Cannot open input image: " .
	"$$pfi_info{'image'}" . "\n";
	binmode(IMAGE);
	&copy_bytes(\IMAGE, \FILE, $$pfi_info{'size'});
	close(IMAGE) or die "[ ERROR: Cannot close input image: " .
	"$$pfi_info{'image'}" . "\n";
	}
	close(FILE) or die "[ ERROR: 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 "[ ERROR: Config file has no 'targets' section!\n";

	for ($i = 0 ; $i < scalar(@parameters) ; $i++ ) {
	INFO("[ Processing target '$parameters[$i]'...\n");
	@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]);
	}

	INFO("[ Success.\n");


	}

	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