#!/usr/bin/perl -w

# Copyright (c) 2001 Leigh Brown.  Released under the GNU GPL.  No warranty.
# You know the drill.

require 5.005;
use strict;
use vars qw(@fields);

sub err_exit($) {
	print STDERR $_[0], "\n";
	exit 1
}

sub usage {
	err_exit "Usage: $0 <-s\"command line\" | -q> <file>";
}

sub open_image($) {
	my $fh;
	open $fh, "+<$_[0]" or
		err_exit "cannot open $_[0]: $!";
	return $fh;
}

sub file_length($) {
	my $pos = sysseek($_[0], 0, 1);
	my $len = sysseek($_[0], 0, 2);
	sysseek($_[0], $pos, 0);
	return $len;
}

	
sub read_header($) {
	if (sysseek($_[0], 0x200, 0) != 0x200) {
		err_exit "$0: seek failed: $!"
	}
	my $data;
	if (sysread($_[0], $data, 0x400) != 0x400) {
		err_exit "$0: sysread failed"
	}
	return unpack "VVCCA32x470Z256", $data;
}
	
sub read_and_verify_header($) {
#	my @stat = stat $_[0];
#	err_exit "$0: file is too short: $stat[7]"
#		if $stat[7] < 0x504;

	@fields = read_header $_[0];
	err_exit "$0: offset incorrect: $fields[0]"
		if $fields[0] != 0x500;
	err_exit "$0: length too small: $fields[1]"
		if $fields[1] < 0x504;
#	err_exit "$0: length too large: $fields[1]"
#		if $fields[1] > $stat[7];
}

sub query_image() {
	my $fh = open_image $ARGV[1];
	read_and_verify_header $fh;
 
	print "$ARGV[1]\n", "-" x length $ARGV[1], "\n";
	printf "Entry point offset  = 0x%08x\n", $fields[0];
	printf "Load image length   = 0x%08x\n", $fields[1];
	printf "Load image Flags    = 0x%02x\n", $fields[2];
	printf "Operating system id = 0x%02x\n", $fields[3];
	print  "Partition name      = [$fields[4]]\n";
	if (length $fields[5] > 40) {
		print  "Command line:\n$fields[5]\n";
	} else {
		print "Command line        = [$fields[5]]\n";
	}
}
	
sub set_command_line($) {
	my $fh = open_image $ARGV[1];
	read_and_verify_header $fh;

	if (sysseek($fh, 0x400, 0) != 0x400) {
		err_exit "$0: seek failed: $!"
	}
	my $data = pack "Z256", $_[0];
	if (syswrite($fh, $data) != 0x100) {
		err_exit "$0: syswrite failed: $1"
	}
}

usage unless scalar @ARGV == 2;

foreach ($ARGV[0]) {
	/^-q$/		and query_image,		last;
	/^-s(.*)$/	and set_command_line($1),	last;
	usage;
}