#!/usr/bin/perl

# test_fru
#
# Test of the FRU code.
#
# Author: MontaVista Software, Inc.
#         Corey Minyard <minyard@mvista.com>
#         source@mvista.com
#
# Copyright 2004 MontaVista Software Inc.
#
#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU Lesser General Public License
#  as published by the Free Software Foundation; either version 2 of
#  the License, or (at your option) any later version.
#
#
#  THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED
#  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
#  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
#  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
#  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
#  BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
#  OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
#  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
#  TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
#  USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
#  You should have received a copy of the GNU Lesser General Public
#  License along with this program; if not, write to the Free
#  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#

use Lanserv;
use OpenIPMI;

my $errcountholder : shared = 0;
$errcount = \$errcountholder;

my $fru_field_table = {};

sub reg_err {
    my $str = shift;

    $$errcount++;
    print STDERR "***", $str, "\n";
}

sub get_errcount {
    return $$errcount;
}

# Check a data field from the fru.  Parameters are:
#  fru - where to get the data from
#  name - The name of the field to check
#  num - The number of the field to check, ignored if the field doesn't
#    support numbers.
#  exp_type - The expected type (integer, time, ascii, binary, unicode).
#  exp_val - The expected value.  For integers and ASCII strings, this
#    is the value.  For binary and unicode, this is a string with the
#    values listed out.  If the value is expected to not be there, this
#    should be undefined.
sub check_fru_data {
    my $fru = shift;
    my $name = shift;
    my $num = shift;
    my $exp_type = shift;
    my $exp_val = shift;
    my $idx = $fru_field_table->{$name};
    my ($tname, $type, $val);
    my $tnum = $num;

    if (!defined $idx) {
	main::reg_err("Invalid name in check_fru_data: $name");
	return;
    }
    
    ($tname, $type, $val) = split /\s+/, $fru->get($idx, \$tnum), 3;

    if (!defined $tname) {
	main::reg_err("Internal error on: $name [$num]");
	return;
    }

    if (!defined $type) {
	if (defined $exp_val) {
	    main::reg_err("value for $name [$num] was undefined, expected $exp_val");
	}
	return;
    }

    if ($name ne $tname) {
	main::reg_err("Internal error on: $name [$num], $tname");
	return;
    }

    if ($exp_type ne $type) {
	main::reg_err("Type mismatch on $name [$num], expected $exp_type, got $type");
	return;
    }

    # If the length of the thing is zero, there won't be anything in the string.  That's ok,
    # but make the comparisons work.
    if (!defined $val) {
	$val = "";
    }

    if (($exp_type eq "integer") || ($exp_type eq "time")) {
	if ($exp_val != $val) {
	    main::reg_err("Value mismatch on $name [$num], expected $exp_val, got $val");
	    return;
	}
    } elsif ($exp_type eq "ascii") {
	if ($exp_val ne $val) {
	    main::reg_err("Value mismatch on $name [$num], expected '$exp_val', got '$val'");
	    return;
	}
    } elsif (($exp_type ne "binary") || ($exp_type ne "unicode")) {
	my @vals = split /\s+/, $val;
	my @exp_vals = split /\s+/, $exp_val;
	my $i;
	if ($#vals != $#exp_vals) {
	    main::reg_err("Value mismatch on $name [$num], expected $#exp_vals values, got $#vals");
	    return;
	}
	$i = 1;
	$val = shift(@vals);
	$exp_val = shift(@exp_vals);
	while (defined $val) {
	    if (hex($val) != hex($exp_val)) {
		main::reg_err("Value mismatch on $name [$num] item $i, expected $exp_val, got $val");
		return;
	    }
	    $val = shift(@vals);
	    $exp_val = shift(@exp_vals);
	    $i++;
	}
    } else {
	main::reg_err("Invalid type on $name [$num]: $exp_type");
	return;
    }
}

sub check_fru_mr_data {
    my $fru = shift;
    my $num = shift;
    my $exp_type = shift;
    my $exp_version = shift;
    my $exp_val = shift;
    my ($type, $version, $val);
    my $readval = $fru->get_multirecord($num);

    if (!defined $readval) {
	if (defined $exp_type) {
	    main::reg_err("value for multirecord [$num] was undefined, expected value");
	}
	return;
    }

    ($type, $version, $val) = split /\s+/, $readval, 3;

    if ($type ne $exp_type) {
	    main::reg_err("Value mismatch on multirecord [$num] type, expected $exp_type, got $type");
	    return;
    }

    if ($version ne $exp_version) {
	    main::reg_err("Value mismatch on multirecord [$num] version, expected $exp_version, got $version");
	    return;
    }

    # If the length of the thing is zero, there won't be anything in the string.  That's ok,
    # but make the comparisons work.
    if (!defined $val) {
	$val = "";
    }

    my @vals = split /\s+/, $val;
    my @exp_vals = split /\s+/, $exp_val;
    my $i;
    if ($#vals != $#exp_vals) {
	main::reg_err("Value mismatch on multirecord [$num], expected $#exp_vals values, got $#vals");
	return;
    }
    $i = 1;
    $val = shift(@vals);
    $exp_val = shift(@exp_vals);
    while (defined $val) {
	if (hex($val) != hex($exp_val)) {
	    main::reg_err("Value mismatch on multirecord [$num], expected $exp_val, got $val");
	    return;
	}
	$val = shift(@vals);
	$exp_val = shift(@exp_vals);
	$i++;
    }
}

sub fru_1_data_check {
    my $fru = shift;
    my $version = shift;

    main::check_fru_data($fru, "internal_use_version", -1, "integer", "1");
    if ($version == 0) {
	main::check_fru_data($fru, "internal_use", -1, "binary",
			     "0x02 0x03 0x04 0x05 0x06 0x07 0x08");
    } else {
	main::check_fru_data($fru, "internal_use", -1, "binary",
			     "0x02 0x03 0x04 0x05 0x06 0x07 0x08 0x09 0x0a 0x0b 0x0c 0x0d 0x0e 0x0f 0x10");
    }

    main::check_fru_data($fru, "chassis_info_version", -1, "integer", "1");
    main::check_fru_data($fru, "chassis_info_type", -1, "integer", "1");
    if ($version == 0) {
	main::check_fru_data($fru, "chassis_info_part_number", -1, "ascii",
			     "ATCA");
	main::check_fru_data($fru, "chassis_info_serial_number", -1, "ascii",
			     "Tes0");
	  main::check_fru_data($fru, "chassis_info_custom", 0, "ascii", "");
	  main::check_fru_data($fru, "chassis_info_custom", 1, "ascii", "xyz");
	  main::check_fru_data($fru, "chassis_info_custom", 2, "ascii", undef);
    } else {
	main::check_fru_data($fru, "chassis_info_part_number", -1, "binary",
			     "0x40");
	main::check_fru_data($fru, "chassis_info_serial_number", -1, "binary",
			     "0x99 0x88 0x77");
	main::check_fru_data($fru, "chassis_info_custom", 0, "ascii", undef);
    }

    main::check_fru_data($fru, "board_info_version", -1, "integer", "1");
    # OpenIPMI converts 0 to 25 (english)
    main::check_fru_data($fru, "board_info_lang_code", -1, "integer", "25");
    main::check_fru_data($fru, "board_info_mfg_time", -1, "time", "820476000");
    main::check_fru_data($fru, "board_info_board_manufacturer", -1, "ascii", "Tes1");
    if ($version == 0) {
    	main::check_fru_data($fru, "board_info_board_product_name", -1, "ascii", "am4001");
    } else {
    	main::check_fru_data($fru, "board_info_board_product_name", -1, "ascii", "AM4001");
    }
    main::check_fru_data($fru, "board_info_board_serial_number", -1, "ascii", "Tes3");
    main::check_fru_data($fru, "board_info_board_part_number", -1, "ascii", "Tes4");
    main::check_fru_data($fru, "board_info_fru_file_id", -1, "ascii", "Tes5");
    main::check_fru_data($fru, "board_info_custom", 0, "ascii", undef);

    main::check_fru_data($fru, "product_info_version", -1, "integer", "1");
    # OpenIPMI converts 0 to 25 (english)
    main::check_fru_data($fru, "product_info_lang_code", -1, "integer", "25");
    main::check_fru_data($fru, "product_info_manufacturer_name", -1, "ascii", "");
    if ($version == 0) {
	main::check_fru_data($fru, "product_info_product_name", -1, "ascii", "Te6");
    } else {
	main::check_fru_data($fru, "product_info_product_name", -1, "ascii", "TE");
    }
    main::check_fru_data($fru, "product_info_product_part_model_number", -1, "ascii",
			 "abcdefghijklmnopqrstuvwxyz012345abcdefghijklmnopqrstuvwxyz01234");
    main::check_fru_data($fru, "product_info_product_version", -1, "binary",
			 "0x01 0x02 0x03 0x04 0x05 0x06 0x07");
    main::check_fru_data($fru, "product_info_product_serial_number", -1, "ascii", "");
    main::check_fru_data($fru, "product_info_asset_tag", -1, "ascii", "12345678");
    main::check_fru_data($fru, "product_info_fru_file_id", -1, "ascii", '3=8FH$ B');
    main::check_fru_data($fru, "product_info_custom", 0, "ascii", 'abcd');
    if ($version == 0) {
	main::check_fru_data($fru, "product_info_custom", 1, "ascii", undef);
    } else {
	main::check_fru_data($fru, "product_info_custom", 1, "ascii",
			     "abcdefghijklmnopqrstuvwxyz012345abcdefghijklmnopqrstuvwxyz01234");
	main::check_fru_data($fru, "product_info_custom", 2, "ascii",
			     "ASDF1234*()");
	main::check_fru_data($fru, "product_info_custom", 3, "ascii",
			     "1234567890--.");
    }


    if ($version == 0) {
	main::check_fru_mr_data($fru, 0, 0xc0, 2, "0x01 0x02 0x03 0x04 0x05 0x06 0x07 0x08 0x09 0x0a 0x0b 0x0c 0x0d 0x0e 0x0f 0x10");
	main::check_fru_mr_data($fru, 1, 0xc1, 2, "");
	main::check_fru_mr_data($fru, 2, undef, undef, undef);
    } else {
	main::check_fru_mr_data($fru, 0, 0xc1, 2, "");
	main::check_fru_mr_data($fru, 1, 0xc2, 2, "0x87 0x55 0x23 0x32 0x99");
	main::check_fru_mr_data($fru, 2, 0xc3, 2, "0x87 0xfe 0x99");
	main::check_fru_mr_data($fru, 3, 0xc4, 2, "");
	main::check_fru_mr_data($fru, 4, undef, undef, undef);
    }
}

sub check_area_offset {
    my $fru = shift;
    my $area = shift;
    my $exp_size = shift;
    my $size;
    my $rv;

    $rv = $fru->area_get_offset($area, \$size);
    if ($rv) {
	if (!defined $exp_size) {
	    # expected
	    return;
	}

	main::reg_err("or getting area offset for area $area: $rv");
	return;
    }

    if ($size != $exp_size) {
	main::reg_err(" offset for area $area was $size, expected $exp_size");
    }
}

sub check_area_length {
    my $fru = shift;
    my $area = shift;
    my $exp_length = shift;
    my $length;
    my $rv;

    $rv = $fru->area_get_length($area, \$length);
    if ($rv) {
	if (!defined $exp_length) {
	    # expected
	    return;
	}

	main::reg_err("Error getting area length for area $area: $rv");
	return;
    }

    if ($length != $exp_length) {
	main::reg_err("FRU length for area $area was $length, expected $exp_length");
    }
}

sub check_area_used_length {
    my $fru = shift;
    my $area = shift;
    my $exp_length = shift;
    my $length;
    my $rv;

    $rv = $fru->area_get_used_length($area, \$length);
    if ($rv) {
	if (!defined $exp_length) {
	    # expected
	    return;
	}

	main::reg_err("Error getting area used length for area $area: $rv");
	return;
    }

    if ($length != $exp_length) {
	main::reg_err("FRU used length for area $area was $length, expected $exp_length");
    }
}

$tmpfru = undef;

sub check_area {
    my $fru = shift;
    my $area = shift;
    my $exp_offset = shift;
    my $exp_length = shift;
    my $exp_used_length = shift;

    check_area_offset($fru, $area, $exp_offset);
    check_area_length($fru, $area, $exp_length);
    check_area_used_length($fru, $area, $exp_used_length);
}

sub dup_fru {
    my $newfru = shift;
    my $oldfru = shift;
    my $i;
    my $rv;
    my $str;
    my $num;
    my $oldnum;

    for $i (0 .. 4) {
	my ($offset, $length);
	$rv = $oldfru->area_get_offset($i, \$offset);
	if ($rv) {
	    main::reg_err("Error getting old FRU offset: $rv");
	    $h->close();
	    return $rv;
	}
	$rv = $oldfru->area_get_length($i, \$length);
	if ($rv) {
	    main::reg_err("Error getting old FRU offset: $rv");
	    $h->close();
	    return $rv;
	}
	$rv = $newfru->add_area($i, $offset, $length);
	if ($rv) {
	    main::reg_err("Error adding FRU area: $rv");
	    $h->close();
	    return $rv;
	}
    }

    $i = 0;
    $num = 0;
    $oldnum = $num;
    $str = $oldfru->get($i, \$num);
    while (defined $str) {
	my ($name, $type, $val) = split /\s+/, $str, 3;
	
	# Make sure to ignore the FRU area things when setting values.
	if (!($name =~ /.*_length/) && !($name =~ /.*_offset/) && defined $type) {
	    $rv = $newfru->set($i, $oldnum, $type, $val);

	    # Check if we didn't have write permissions, that's ok just go on.
	    if ($rv && ($rv != $OpenIPMI::eperm)) {
		main::reg_err("Error setting fru field $i [$num]: $rv");
		  $h->close();
		  return $rv;
	      }
	}
	if ($num < 1) {
	    $num = 0;
	    $i++;
	}
	$oldnum = $num;
	$str = $oldfru->get($i, \$num);
    }

    $num = $oldfru->get_num_multi_records() - 1;
    for $i (0 .. $num) {
	my ($type, $ver, $val) = split /\s+/, $oldfru->get_multirecord($i), 3;

	# If the data is empty for the record, val will be undefined by
	# the split, but we need to define it because undefined means
	# delete.
	if (!defined $val) {
	    $val = "";
	}

	$rv = $newfru->set_multirecord($i, $type, $ver, $val);
	if ($rv) {
	    main::reg_err("Error setting multi-record [$i]: $rv");
	    $h->close();
	    return $rv;
	}
    }
}

{
    package CloseDomain;
    sub new {
	my $a = shift;
	my $b = \$a;
	$b = bless $b;
	return $b;
    }

    sub domain_cb {
	my $self = shift;
	my $domain = shift;

	$domain->close($$self);
    }

    package CheckRead4;

    sub new {
	my $self = shift;
	my $a = {};
	$a->{handler} = shift;
	return bless \$a;
    }

    sub fru_fetched {
	print "CheckRead4: Fru fetched\n";

	my $self = shift;
	my $domain = shift;
	my $fru = shift;
	my $err = shift;
	my $h = $$self->{handler};
	my $rv;
	my $i;
	my $num;
	my $str;

	if ($err) {
	    main::reg_err("Error reading the second FRU: $err");
	    $h->close();
	    return;
	}

	print "Second FRU fetched\n";
	main::fru_1_data_check($fru, 1);

	# Done with tests
	$h->close();
    }

    package CheckRead3;

    sub new {
	my $self = shift;
	my $a = {};
	$a->{handler} = shift;
	return bless \$a;
    }

    sub fru_written {
	print "CheckRead3: Fru written\n";

	my $self = shift;
	my $domain = shift;
	my $fru = shift;
	my $err = shift;
	my $h = $$self->{handler};
	my $rv;

	if ($err) {
	    main::reg_err("Error writing the FRU: $err");
	    $h->close();
	    return;
	}

	print "FRU written\n";

	# Now re-read the FRU.
	$rv = $domain->fru_alloc(1, 0x20, 1, 0, 0, 0, CheckRead4->new($h));
	if (! defined $rv) {
	    main::reg_err("Error starting fru fetch: $rv");
	    $self->close();
	    return;
	}
    }

    sub fru_fetched {
	print "CheckRead3: Fru fetched\n";

	my $self = shift;
	my $domain = shift;
	my $fru = shift;
	my $err = shift;
	my $h = $$self->{handler};
	my $rv;
	my $i;
	my $num;
	my $str;

	if ($err != $OpenIPMI::enosys) {
	    main::reg_err("Wrong error reading the FRU: $err");
	    $h->close();
	    return;
	}

	print "Bad FRU fetched, copy the prevous FRU to it\n";
	main::dup_fru($fru, $main::tmpfru);
	if (main::get_errcount()) {
	    $h->close();
	    return;
	}
	main::fru_1_data_check($fru, 1);
	if (main::get_errcount()) {
	    $h->close();
	    return;
	}

	$rv = $fru->write($self);
	if ($rv) {
	    main::reg_err("Error writing FRU: $rv");
	    $h->close();
	}
    }

    package CheckRead2;

    sub new {
	my $self = shift;
	my $a = {};
	$a->{handler} = shift;
	return bless \$a;
    }

    sub fru_fetched {
	print "CheckRead2: Fru fetched\n";

	my $self = shift;
	my $domain = shift;
	my $fru = shift;
	my $err = shift;
	my $h = $$self->{handler};
	my $rv;
	my $i;
	my $num;

	if ($err) {
	    main::reg_err("Error reading the FRU: $err");
	    $main::lanserv->clearlines();
	    $main::lanserv->cmd("mc_dump_fru_data 20 0");
	    for ($i=0; $i<128; $i++) {
		print $main::lanserv->waitnextline(), "\n";
	    }
	    $h->close();
	    return;
	}

	print "FRU refetched\n";
	main::fru_1_data_check($fru, 1);
	main::check_area($fru, 0, 8, 16, 16);
	main::check_area($fru, 1, 24, 16, 11);
	main::check_area($fru, 2, 96, 40, 34);
	main::check_area($fru, 3, 192, 256, 181);
	main::check_area($fru, 4, 512, 512, 28);

	$main::tmpfru = $fru;

	print "Fetch a bad FRU\n";
	$rv = $domain->fru_alloc(1, 0x20, 1, 0, 0, 0, CheckRead3->new($h));
	if (! defined $rv) {
	    main::reg_err("Error starting fru fetch: $rv");
	    $h->close();
	    return;
	}
    }

    package CheckRead1;

    sub new {
	my $self = shift;
	my $a = {};
	$a->{handler} = shift;
	return bless \$a;
    }

    sub fru_written {
	print "CheckRead1: Fru written\n";

	my $self = shift;
	my $domain = shift;
	my $fru = shift;
	my $err = shift;
	my $h = $$self->{handler};
	my $rv;

	if ($err) {
	    main::reg_err("Error writing the FRU: $err");
	    $h->close();
	    return;
	}

	print "FRU written\n";

	# Now re-read the FRU.
	$rv = $domain->fru_alloc(1, 0x20, 0, 0, 0, 0, CheckRead2->new($h));
	if (! defined $rv) {
	    main::reg_err("Error starting fru fetch: $rv");
	    $self->close();
	    return;
	}
    }

    sub fru_fetched {
	print "CheckRead1: Fru fetched\n";

	my $self = shift;
	my $domain = shift;
	my $fru = shift;
	my $err = shift;
	my $h = $$self->{handler};
	my $rv;
	my $idx;
	my $num;

	if ($err) {
	    main::reg_err("Error reading the FRU: $err");
	    $h->close();
	    return;
	}

	print "FRU data read, checking\n";
	main::check_area($fru, 0, 8, 8, 8);
	main::check_area($fru, 1, 16, 24, 20);
	main::check_area($fru, 2, 48, 40, 35);
	main::check_area($fru, 3, 88, 104, 100);
	main::check_area($fru, 4, 192, 832, 26);

	main::fru_1_data_check($fru, 0);

	if (main::get_errcount()) {
	    $h->close();
	    return;
	}

	print "Fiddle with area offsets and lengths\n";
	# Move the chassis info area out by 16.  This should fail.
	$rv = $fru->area_set_offset(1, 32);
	if (!$rv) {
	    main::reg_err("Setting the FRU offset to a used offset didn't fail");
	    $h->close();
	    return;
	}

	# Move the chassis info area out by 8.  This should succeed.
	$rv = $fru->area_set_offset(1, 24);
	if ($rv) {
	    main::reg_err("Error setting the FRU offset: $rv");
	    $h->close();
	    return;
	}

	# Increasing the length should fail.
	$rv = $fru->area_set_length(1, 32);
	if (!$rv) {
	    main::reg_err("Increasing the FRU length didn't fail");
	    $h->close();
	    return;
	}

	# Decreasing the length should fail.
	$rv = $fru->area_set_length(1, 16);
	if (!$rv) {
	    main::reg_err("Decreasing the FRU length didn't fail");
	    $h->close();
	    return;
	}

	# This should just barely fit.
	$rv = $fru->set($fru_field_table->{chassis_info_part_number},
			-1, "ascii", "abcdefg");
	if ($rv) {
	    main::reg_err("Error setting chassis info part number to 8: $rv");
	    $h->close();
	    return;
	}
	main::check_fru_data($fru, "chassis_info_part_number", -1, "ascii",
			     "abcdefg");

	# This should not fit.
	$rv = $fru->set($fru_field_table->{chassis_info_part_number},
			-1, "ascii", "jjjjjjjjj");
	if (!$rv) {
	    main::reg_err("Setting value of chassis info long didn't fail");
	    $h->close();
	    return;
	}
	main::check_fru_data($fru, "chassis_info_part_number", -1, "ascii",
			     "abcdefg");

	# Decrease the size of the chassis info area so we are 1 byte
	# too long to decrease the length.
	$rv = $fru->set_array($fru_field_table->{chassis_info_part_number},
			      -1, "binary", [ 0x40 ]);
	if ($rv) {
	    main::reg_err("Error setting chassis info part number: $rv");
	    $h->close();
	    return;
	}
	main::check_fru_data($fru, "chassis_info_part_number", -1, "binary",
			     "0x40");

	# Decreasing the length should fail.
	$rv = $fru->area_set_length(1, 16);
	if (!$rv) {
	    main::reg_err("Decreasing the FRU length didn't fail");
	    $h->close();
	    return;
	}

	main::check_area($fru, 0, 8, 8, 8);
	main::check_area($fru, 1, 24, 24, 17);
	main::check_area($fru, 2, 48, 40, 35);
	main::check_area($fru, 3, 88, 104, 100);
	main::check_area($fru, 4, 192, 832, 26);

	print "Fiddle with area size\n";
	# Decrease the size of the chassis info area so we can decrease
	# the length.
	$rv = $fru->set($fru_field_table->{chassis_info_serial_number},
			-1, "binary", "0x99 0x88 0x77");
	if ($rv) {
	    main::reg_err("Error setting chassis info serial number: $rv");
	    $h->close();
	    return;
	}

	# Decreasing the length should succeed.
	$rv = $fru->area_set_length(1, 16);
	if ($rv) {
	    main::reg_err("Error decreasing chassis info area length: $rv");
	    $h->close();
	    return;
	}

	main::check_area($fru, 0, 8, 8, 8);
	main::check_area($fru, 1, 24, 16, 16);
	main::check_area($fru, 2, 48, 40, 35);
	main::check_area($fru, 3, 88, 104, 100);
	main::check_area($fru, 4, 192, 832, 26);

	print "Fiddle with area size some more\n";
	# Decreasing the length should succeed.
	$rv = $fru->area_set_length(1, 16);
	if ($rv) {
	    main::reg_err("Error decreasing chassis info area length: $rv");
	    $h->close();
	    return;
	}

	print "Move areas around\n";
	# Move everything out.
	$rv = $fru->area_set_offset(4, 512);
	if ($rv) {
	    main::reg_err("Error setting multi-record offset: $rv");
	    $h->close();
	    return;
	}
	$rv = $fru->area_set_offset(3, 192);
	if ($rv) {
	    main::reg_err("Error setting product info offset: $rv");
	    $h->close();
	    return;
	}
	$rv = $fru->area_set_offset(2, 96);
	if ($rv) {
	    main::reg_err("Error setting board info offset: $rv");
	    $h->close();
	    return;
	}

	main::check_area($fru, 0, 8, 8, 8);
	main::check_area($fru, 1, 24, 16, 16);
	main::check_area($fru, 2, 96, 40, 35);
	main::check_area($fru, 3, 192, 104, 100);
	main::check_area($fru, 4, 512, 512, 26);

	print "Increasing length of product info area and adding values\n";
	$rv = $fru->area_set_length(3, 256);
	if ($rv) {
	    main::reg_err("Error increasing product info area length: $rv");
	    $h->close();
	    return;
	}
	main::check_area($fru, 0, 8, 8, 8);
	main::check_area($fru, 1, 24, 16, 16);
	main::check_area($fru, 2, 96, 40, 35);
	main::check_area($fru, 3, 192, 256, 100);
	main::check_area($fru, 4, 512, 512, 26);

	# This should truncate
	$rv = $fru->set($fru_field_table->{product_info_custom}, 7, "ascii",
			"abcdefghijklmnopqrstuvwxyz012345abcdefghijklmnopqrstuvwxyz012345");
	if ($rv) {
	    main::reg_err("Error setting product info custom 1: $rv");
	    $h->close();
	    return;
	}
	main::check_fru_data($fru, "product_info_custom", 1, "ascii",
			     "abcdefghijklmnopqrstuvwxyz012345abcdefghijklmnopqrstuvwxyz01234");
	main::check_area($fru, 3, 192, 256, 164);
	$rv = $fru->set($fru_field_table->{product_info_custom}, 7, "ascii",
			"ASDF1234*()");
	if ($rv) {
	    main::reg_err("Error setting product info custom 2: $rv");
	    $h->close();
	    return;
	}
	main::check_fru_data($fru, "product_info_custom", 2, "ascii",
			     "ASDF1234*()");
	main::check_area($fru, 3, 192, 256, 174);

	# Convert an 8-bit field to a 6-bit field in board info
	$rv = $fru->set($fru_field_table->{board_info_board_product_name}, -1,
			"ascii", "AM4001");
	if ($rv) {
	    main::reg_err("Error setting board info board product name: $rv");
	    $h->close();
	    return;
	}

	# Convert an 8-bit field to a 6-bit field
	$rv = $fru->set($fru_field_table->{product_info_product_name}, -1, "ascii",
			"TE");
	if ($rv) {
	    main::reg_err("Error setting product info product name: $rv");
	    $h->close();
	    return;
	}
	main::check_fru_data($fru, "product_info_product_name", -1, "ascii",
			     "TE");

	$rv = $fru->set($fru_field_table->{product_info_custom}, 7, "ascii",
			"1234567890--.");
	if ($rv) {
	    main::reg_err("Error setting product info custom 3: $rv");
	    $h->close();
	    return;
	}
	main::check_fru_data($fru, "product_info_custom", 3, "ascii",
			     "1234567890--.");
	$rv = $fru->set_multirecord(7, 0xc2, 2, "0x87 0x55 0x23 0x32 0x99");
	if ($rv) {
	    main::reg_err("Error setting multirecord 2: $rv");
	    $h->close();
	    return;
	}
	main::check_fru_mr_data($fru, 2, 0xc2, 2, "0x87 0x55 0x23 0x32 0x99");
	main::check_area($fru, 4, 512, 512, 36);
	$rv = $fru->set_multirecord_array(7, 0xc3, 2, [ 0x87, 0xfe, 0x99 ]);
	if ($rv) {
	    main::reg_err("Error setting multirecord 3: $rv");
	    $h->close();
	    return;
	}
	main::check_fru_mr_data($fru, 3, 0xc3, 2, "0x87 0xfe 0x99");
	main::check_area($fru, 4, 512, 512, 44);
	$rv = $fru->set_multirecord_array(7, 0xc4, 2, [ ]);
	if ($rv) {
	    main::reg_err("Error setting multirecord 3: $rv");
	    $h->close();
	    return;
	}
	main::check_fru_mr_data($fru, 4, 0xc4, 2, "");
	main::check_area($fru, 4, 512, 512, 49);
	$rv = $fru->set_multirecord(7, 0xc5, 2, "");
	if ($rv) {
	    main::reg_err("Error setting multirecord 2: $rv");
	    $h->close();
	    return;
	}
	main::check_fru_mr_data($fru, 5, 0xc5, 2, "");
	main::check_area($fru, 4, 512, 512, 54);

	$rv = $fru->set_multirecord(0, 0, 0, undef);
	if ($rv) {
	    main::reg_err("Error deleting multirecord 0: $rv");
	    $h->close();
	    return;
	}
	main::check_area($fru, 4, 512, 512, 33);

	$rv = $fru->set_multirecord(4, 0, 0, undef);
	if ($rv) {
	    main::reg_err("Error deleting multirecord 4: $rv");
	    $h->close();
	    return;
	}
	main::check_area($fru, 4, 512, 512, 28);

	$rv = $fru->set($fru_field_table->{chassis_info_custom}, 1, "ascii",
			undef);
	if ($rv) {
	    main::reg_err("Error clearing chassis info custom 1: $rv");
	    $h->close();
	    return;
	}
	main::check_fru_data($fru, "chassis_info_custom", 1, "ascii", undef);
	main::check_area($fru, 1, 24, 16, 12);
	$rv = $fru->set($fru_field_table->{chassis_info_custom}, 0, "ascii",
			undef);
	if ($rv) {
	    main::reg_err("Error clearing chassis info custom 0: $rv");
	    $h->close();
	    return;
	}
	main::check_fru_data($fru, "chassis_info_custom", 0, "ascii", undef);
	main::check_area($fru, 1, 24, 16, 11);

	print "Cleaning up the internal area\n";
	$rv = $fru->area_set_length(0, 16);
	if ($rv) {
	    main::reg_err("Error increasing internal use area length: $rv");
	    $h->close();
	    return;
	}
	$rv = $fru->set($fru_field_table->{internal_use}, 0, "binary",
			"0x02 0x03 0x04 0x05 0x06 0x07 0x08 0x09 0x0a 0x0b 0x0c 0x0d 0x0e 0x0f 0x10");
	if ($rv) {
	    main::reg_err("Error clearing chassis info custom 0: $rv");
	    $h->close();
	    return;
	}

	print "Writing out the FRU\n";
	# Make sure it's what we want.
	main::fru_1_data_check($fru, 1);

	$rv = $fru->write($self);
	if ($rv) {
	    main::reg_err("Error writing FRU: $rv");
	    $h->close();
	}
    }


    package Handlers;

    sub new {
	my $a = {};
	$a->{keepon} = 1;
	return bless \$a;
    }

    sub log {
	my $self = shift;
	my $level = shift;
	my $log = shift;

	print $level, ": ", $log, "\n";
    }
    
    sub conn_change_cb {
	my $self = shift;
	my $domain = shift;
	my $err = shift;
	my $conn_num = shift;
	my $port_num = shift;
	my $still_connected = shift;
	my $rv;

	if ($err) {
	    main::reg_err("Error starting up IPMI connection: $err");
	    $self->close();
	    return;
	}

	print "Connection up!\n";
	$rv = $domain->fru_alloc(1, 0x20, 0, 0, 0, 0, CheckRead1->new($self));
	if (! defined $rv) {
	    main::reg_err("Error starting fru fetch: $rv");
	    $self->close();
	    return;
	}
    }

    sub domain_close_done_cb {
	my $self = shift;

	$$self->{keepon} = 0;
    }

    sub close {
	my $self = shift;
	my $domain = shift;

	if (defined $$self->{domain_id}) {
	    my $v = CloseDomain::new($self);
	    $$self->{domain_id}->to_domain($v);
	} else {
	    $$self->{keepon} = 0;
	}
    }

}

package main;

$lanserv = Lanserv->new();
if (! $lanserv) {
    main::reg_err("Unable to start lanserv");
    exit(1);
}

# Add a BMC
$lanserv->cmd("mc_add 0x20 0 has-device-sdrs 0x23 9 8 0x1f 0x1291 0xf02");
$lanserv->cmd("main_sdr_add 0x20 0x00 0x00 0x51 0x12 0x0f 0x20 0x00 0x00 0x1f 0x00 0x00 0x00 0x07 0x01 0x00 0xc4 'T 'e 's 't");

# Create some FRU information
$lanserv->cmd
    ("mc_add_fru_data 0x20 0x0 0x400 data " .
     " 0x01 0x01 0x02 0x06 0x0b 0x18 0x00 0xd3" .
# Internal Use
     " 0x01 0x02 0x03 0x04 0x05 0x06 0x07 0x08" .
# Chassis info
     " 0x01 0x03 0x01 0xc4 'A 'T 'C 'A" .
     " 0xc4 'T 'e 's '0 0xc0 0xc3 'x" .
     " 'y 'z 0xc1 0x00 0x00 0x00 0x00 0x4f" .
# Expansion space
     " 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00" .
# Board info
     " 0x01 0x05 0x00 0x00 0x00 0x00 0xc4 'T" .
     " 'e 's '1 0xc6 'a 'm '4 '0" .
     " '0 '1 0xc4 'T 'e 's '3 0xc4" .
     " 'T 'e 's '4 0xc4 'T 'e 's" .
     " '5 0xc1 0x00 0x00 0x00 0x00 0x00 0x53" .
#Product Info
     " 0x01 0x0d 0x00 0xc0 0xc3 'T 'e '6" .
     " 0xff 'a 'b 'c 'd 'e 'f 'g" .
     " 'h 'i 'j 'k 'l 'm 'n 'o" .
     " 'p 'q 'r 's 't 'u 'v 'w" .
     " 'x 'y 'z '0 '1 '2 '3 '4" .
     " '5 'a 'b 'c 'd 'e 'f 'g" .
     " 'h 'i 'j 'k 'l 'm 'n 'o" .
     " 'p 'q 'r 's 't 'u 'v 'w" .
     " 'x 'y 'z '0 '1 '2 '3 '4" .
     " 0x07 0x01 0x02 0x03 0x04 0x05 0x06 0x07" .
     " 0xc0 0x48 0x21 0x43 0x65 0x87 0x88 0x53" .
     " 0x87 0x99 0x28 0x01 0x88 0xc4 'a 'b" .
     " 'c 'd 0xc1 0x00 0x00 0x00 0x00 0xe4" .
# Multi-records
     " 0xc0 0x02 0x10 0x78 0xb6 0x01 0x02 0x03" .
     " 0x04 0x05 0x06 0x07 0x08 0x09 0x0a 0x0b" .
     " 0x0c 0x0d 0x0e 0x0f 0x10 0xc1 0x82 0x00" .
     " 0x00 0xbd"
);

# Create a dummy FRU that has an error
$lanserv->cmd("mc_add_fru_data 0x20 1 0x400 data 0x01");

$lanserv->cmd("mc_enable 0x20");

sleep 1;

#OpenIPMI::enable_debug_msg();
OpenIPMI::enable_debug_malloc();

# Now start OpenIPMI
OpenIPMI::init();

$i = 0;
$s = OpenIPMI::fru_index_to_str($i);
while (defined $s) {
    $fru_field_table->{$s} = $i;
    $i++;
    $s = OpenIPMI::fru_index_to_str($i);
}

$h = Handlers::new();

OpenIPMI::set_log_handler($h);

@args = ( "-noseteventrcvr",
	  "lan", "-p", "9000", "-U", "minyard", "-P", "test", "localhost");
$$h->{domain_id} = OpenIPMI::open_domain2("test", \@args, $h, \undef);
if (! $$h->{domain_id}) {
    $lanserv->close();
    print "IPMI open failed\n";
    exit 1;
}

while ($$h->{keepon}) {
    OpenIPMI::wait_io(1000);
}

# Make sure our copy of the FRU is destroyed.
$main::tmpfru = undef;

$lanserv->close();
OpenIPMI::shutdown_everything();
exit main::get_errcount();
