Chip 2001 Mobile/Chip_Mobile_2001.iso/palm/system/_palmemu/palmemu.exe/Scripting/Perl/EmRPC.pm

Perl POD Document | 2000-01-27 | 29.1 KB | 1,268 lines

########################################################################
#
#    File:            EmRPC.pm
#
#    Purpose:        Low-level functions for using RPC with the Palm OS
#                    Emulator.
#
#    Description:    This file contains base functions for using RPC:
#
#                    OpenConnection
#                        Opens a socket to the Emulator
#
#                    CloseConnection
#                        Closes the socket
#
#                    DoRPC
#                        Full-service RPC packet sending and receiving,
#                        including marshalling and unmarshalling of
#                        parameters.
#
#                    ReadBlock
#                        Read up to 256 bytes from the remote device's
#                        memory.
#
#                    WriteBlock
#                        Write up to 256 bytes to the remote device's
#                        memory.
#
#                    ReadString
#                        Read a C string from the remote device's memory.
#
#                    PrintString
#                        Debugging utility.  Prints a Perl string
#                        (block of arbitrary data) as a hex dump.
#
########################################################################

package EmRPC;

use Exporter ();
@ISA = qw(Exporter);

@EXPORT_OK = qw(
    OpenConnection CloseConnection
    DoRPC
    ReadBlock WriteBlock
    ReadString PrintString
);

use IO::Socket;

use constant slkSocketDebugger        =>    0;    # Debugger Socket
use constant slkSocketConsole        =>    1;    # Console Socket
use constant slkSocketRemoteUI        =>    2;    # Remote UI Socket
use constant slkSocketDLP            =>    3;    # Desktop Link Socket
use constant slkSocketFirstDynamic    =>    4;    # first dynamic socket ID
use constant slkSocketPoserRPC        => 14;

use constant slkPktTypeSystem        =>    0;    # System packets
use constant slkPktTypeUnused1        =>    1;    # used to be: Connection Manager packets
use constant slkPktTypePAD            =>    2;    # PAD Protocol packets
use constant slkPktTypeLoopBackTest    =>    3;    # Loop-back test packets


########################################################################
#
#    FUNCTION:        OpenConnection
#
#    DESCRIPTION:    Open a socket-based connection to Poser.
#
#    PARAMETERS:        Port number to talk to (hint, try 6415).
#                    IP address of computer to talk to.  Can be null
#                        to use localhost.
#
#    RETURNED:        Nothing. Dies if fail to connect.
#
########################################################################

sub OpenConnection
{
    ($port_number, $ip_address) = @_;

    if (not defined($sock))
    {
        if (defined($ip_address))
        {
            $remote = $ip_address;
        }
        else
        {
            $remote = "localhost";
        }

        $port = $port_number;

        $sock = new IO::Socket::INET(    PeerAddr => $remote,
                                        PeerPort => $port,
                                        Proto => 'tcp');

        die "cannot connect to poser port. Reason: $@\n" unless $sock;
    }
}


########################################################################
#
#    FUNCTION:        CloseConnection
#
#    DESCRIPTION:    Close the socket connection to Poser.
#
#    PARAMETERS:        None.
#
#    RETURNED:        Nothing.
#
########################################################################

sub CloseConnection
{
    close ($sock);
    undef $sock;
}


########################################################################
#
#    FUNCTION:        DoRPC
#
#    DESCRIPTION:    Performs full, round-trip RPC service.
#
#    PARAMETERS:        Trap word of function to call.
#                    Format string describing parameters.
#                    Parameters to pass in the RPC call.
#
#                    The format string contains a series of format
#                    descriptors.  Descriptors must be seperated by
#                    some sort of delimiter, which can be a space, a
#                    common, a colon, or any combination of those. Each
#                    descriptor has the following format:
#
#                        <type><optional size><optional "*">
#
#                    The "type" describes the parameter in the format
#                    expected by the Palm OS.  The RPC routines will
#                    convert the Perl variable corresponding to the
#                    parameter into the described type.  The following
#                    types are supported:
#
#                        int:        integer
#                        Err:        2 byte integer
#                        Coord:        2 byte integer;
#                        LocalID:    4 byte integer
#                        HostErr:    4 byte integer
#                        string:        C string
#                        rptr:        Pointer to something back on
#                                    the emulated device
#                        point:        Palm OS PointType
#                        rect:        Palm OS RectangleType
#                        block:        Block of arbitrary data
#
#                    Some format types can accept a size specifier
#                    after them.  This size specifier is used when
#                    a default parameter size cannot be implied, or
#                    when you want to override the default parameter
#                    size.  The following describes how the size
#                    specifier is handled for each parameter type:
#
#                        int:
#                            Length specifier must be supplied, and
#                            must be one of 8, 16, or 32.
#
#                        string:
#                            Default length is the value as returned
#                            by Perl's "length" function plus one.
#                            You can override this value by including
#                            your own length specifier.
#
#                        block:
#                            Default length is the value as returned
#                            by Perl's "length" function.  You can
#                            override this value by including your
#                            own length specifier.
#
#                        all others:
#                            Any specified size is ignored.
#
#                    In general, integer types are passed by value, and
#                    all other types are passed by reference.  That is
#                    after all the parameters are marhsalled, sent to
#                    the emulator, and unmarshalled, the "pass by value"
#                    parameters are pushed directly onto the emulated
#                    stack, and "pass by reference" parameters have
#                    their addresses pushed onto the stack.  You can
#                    can change this behavior in one way: if you way
#                    an integer to be passed by reference, then you
#                    can append a "*" to its format specifier.
#
#                    Examples:
#
#                        "int16"
#                            Pass a 2 byte integer
#
#                        "int32 string"
#                            Pass a 4 byte integer, followed by
#                            a C-string
#
#                        "block32"
#                            Pass a 32 byte buffer, filling in
#                            its contents as much as possible
#                            with the given data
#
#                        "int16 in32 int32*"
#                            Pass a 2 byte integer, followed by
#                            a 4 byte integer, followed by a
#                            4 byte integer passed by reference.
#
#    RETURNED:        List containing:
#                        Register D0
#                        Register A0
#                        Full parameter list.  If any parameters were
#                            "pass by reference", you'll receive the
#                            updated parameters.  If parameters are
#                            "pass by value", you'll get them back just
#                            the same way you provided them.
#
########################################################################

sub DoRPC
{
    my ($trap_word, $format, @parameters) = @_;

    my ($slkSocket)        = slkSocketPoserRPC;
    my ($slkPktType)    = slkPktTypeSystem;
    my ($send_body)        = EmRPC::MakeRPCBody ($trap_word, $format, @parameters);

    my ($packet) = MakePacket($slkSocket, $slkSocket, $slkPktType, $send_body);

    SendPacket($packet);

    my ($header, $body, $footer) = ReceivePacket();

    EmRPC::UnmakeRPCBody ($body, $format);
}


########################################################################
#
#    FUNCTION:        ReturnValue
#
#    DESCRIPTION:    .
#
#    PARAMETERS:        .
#
#    RETURNED:        .
#
########################################################################

sub ReturnValue
{
    my ($format, $D0, $A0, @parameters) = @_;

    my ($type, $size, $by_ref) = GetFormat ($format, 0);

    my ($result);

    if ($type eq "int")
    {
        return $D0;
    }
    elsif ($type eq "string")
    {
        return ($A0, ReadString ($A0));
    }
    elsif ($type eq "rptr")
    {
        return $A0;
    }

    die "Unexpected type \"$type\" in EmRPC::ReturnValue, stopped";
}


########################################################################
#
#    FUNCTION:        ReadBlock
#
#    DESCRIPTION:    Read a range of memory from the remote device.
#
#    PARAMETERS:        address of remote device to start reading from.
#                    number of bytes to read (256 max).
#
#    RETURNED:        A Perl string containing the result.
#
########################################################################

$sysPktReadMemCmd        = 0x01;
$sysPktReadMemRsp        = 0x81;

    #    typedef struct SysPktReadMemCmdType {
    #        _sysPktBodyCommon;                                // Common Body header
    #        void*                    address;                // Address to read
    #        Word                    numBytes;                // # of bytes to read
    #        } SysPktReadMemCmdType;
    #    typedef SysPktReadMemCmdType*    SysPktReadMemCmdPtr;
    #
    #    typedef struct SysPktReadMemRspType {
    #        _sysPktBodyCommon;                                // Common Body header
    #        // Byte                data[?];                    // variable size
    #        } SysPktReadMemRspType;
    #    typedef SysPktReadMemRspType*    SysPktReadMemRspPtr;

sub ReadBlock
{
    my ($address, $num_bytes) = @_;

    my ($slkSocket)        = slkSocketPoserRPC;
    my ($slkPktType)    = slkPktTypeSystem;
    my ($send_body)        = pack ("cxNn", $sysPktReadMemCmd, $address, $num_bytes);

    my ($packet) = MakePacket($slkSocket, $slkSocket, $slkPktType, $send_body);

    SendPacket($packet);

    my ($header, $body, $footer) = ReceivePacket();

    unpack ("xx a$num_bytes", $body);
}


########################################################################
#
#    FUNCTION:        WriteBlock
#
#    DESCRIPTION:    Write a range of bytes to the remote device.
#
#    PARAMETERS:        address to start writing to.
#                    a Perl string containing the stuff to write.
#
#    RETURNED:        nothing
#
########################################################################

$sysPktWriteMemCmd        = 0x02;
$sysPktWriteMemRsp        = 0x82;

    #    typedef struct SysPktWriteMemCmdType {
    #        _sysPktBodyCommon;                                // Common Body header
    #        void*                address;                    // Address to write
    #        Word                numBytes;                    // # of bytes to write
    #        // Byte                data[?];                    // variable size data
    #        } SysPktWriteMemCmdType;
    #    typedef SysPktWriteMemCmdType*    SysPktWriteMemCmdPtr;
    #
    #    typedef struct SysPktWriteMemRspType {
    #        _sysPktBodyCommon;                                // Common Body header
    #        } SysPktWriteMemRspType;
    #    typedef SysPktWriteMemRspType*    SysPktWriteMemRspPtr;

sub WriteBlock
{
    my ($address, $data) = @_;

    my ($slkSocket)        = slkSocketPoserRPC;
    my ($slkPktType)    = slkPktTypeSystem;
    my ($send_body)        = pack ("cxNn", $sysPktWriteMemCmd, $address, length ($data)) . $data;

    my ($packet) = MakePacket($slkSocket, $slkSocket, $slkPktType, $send_body);

    SendPacket($packet);

    ReceivePacket();    # receive the results, but we don't need to do anything with them
}


########################################################################
#
#    FUNCTION:        SendPacket
#
#    DESCRIPTION:    Send a fully-built packet to Poser.  The socket
#                    connection to Poser should already have been
#                    established
#
#    PARAMETERS:        The packet to be sent.
#
#    RETURNED:        Nothing.
#
########################################################################

sub SendPacket
{
    my ($packet) = @_;

    print $sock $packet;
}


########################################################################
#
#    FUNCTION:        ReceivePacket
#
#    DESCRIPTION:    Receive a packet from Poser.
#
#    PARAMETERS:        None.
#
#    RETURNED:        The packet header, body, and footer as an array.
#
########################################################################

sub ReceivePacket
{
    my ($header, $body, $footer);

    my ($header_length) = 10;
    sysread($sock, $header, $header_length);

    my ($body_length) = GetBodySize($header);
    sysread($sock, $body, $body_length);

    my ($footer_length) = 2;
    sysread($sock, $footer, $footer_length);

    ($header, $body, $footer);
}


########################################################################
#
#    FUNCTION:        MakePacket
#
#    DESCRIPTION:    Builds up a complete packet for sending to Poser
#                    including the header, body, and footer.
#
#    PARAMETERS:        $src - the source SLP socket.  Generally something
#                        like slkSocketDebugger or slkSocketConsole.
#
#                    $dest - the destination SLP socket.
#
#                    $type - the type of packet.  Generally something
#                        like slkPktTypeSystem or slkPktTypePAD.
#
#                    $body - the body of the packet.
#
#    RETURNED:        The built packet as a Perl string.  The header and
#                    footer checksums will be calculated and filled in.
#
########################################################################

    #    struct SlkPktHeaderType
    #    {
    #        Word    signature1;        // X  first 2 bytes of signature
    #        Byte    signature2;        // X  3 and final byte of signature
    #        Byte    dest;            // -> destination socket Id
    #        Byte    src;            // -> src socket Id
    #        Byte    type;            // -> packet type
    #        Word    bodySize;        // X  size of body
    #        Byte    transID;        // -> transaction Id
    #                                //    if 0 specified, it will be replaced
    #        SlkPktHeaderChecksum    checksum;    // X  check sum of header
    #    };
    #
    #    struct SlkPktFooterType
    #    {
    #        Word    crc16;            // header and body crc
    #    };

$header_template = "H6CCCnCC";        # 6 Hex digits, 3 unsigned chars, a B.E. short, 2 unsigned chars
$footer_template = "n";                # a B.E. short

$signature = "BEEFED";

sub MakePacket
{
    my ($src, $dest, $type, $body) = @_;

    if (not defined($transID))
    {
        $transID = 0;
    }

    ++$transID;

    my ($bodySize) = length ($body);
    my ($header_checksum) = CalcHeaderChecksum ($signature, $dest, $src, $type, $bodySize, $transID);

    my ($header) = pack ($header_template, $signature, $dest, $src, $type, $bodySize, $transID, $header_checksum);

#    my ($footer_checksum) = CalcFooterChecksum ($header, &body);
    my ($footer_checksum) = 0;
    my ($footer) = pack ($footer_template, $footer_checksum);

    $header . $body . $footer;
}


########################################################################
#
#    FUNCTION:        CalcHeaderChecksum
#
#    DESCRIPTION:    Calculate that checksum value for the packet header.
#
#    PARAMETERS:        The components of the header.
#
#    RETURNED:        The checksum that should be placed in the SLP
#                    packet header.
#
########################################################################

sub CalcHeaderChecksum
{
    my ($signature, $dest, $src, $type, $bodySize, $transID) = @_;

    my ($checksum, $temp_buffer);

    $checksum = 0;

    $temp_buffer = pack ($header_template, $signature, $dest, $src, $type, $bodySize, $transID, 0);
    @bytes = unpack("C8", $temp_buffer);
    $checksum = $bytes[0] + $bytes[1] + $bytes[2] + $bytes[3] + $bytes[4] +
                $bytes[5] + $bytes[6] + $bytes[7];

    $checksum % 256;
}


########################################################################
#
#    FUNCTION:        CalcFooterChecksum
#
#    DESCRIPTION:    Calculate the checksum value for the packet footer.
#
#    PARAMETERS:        The header and body.
#
#    RETURNED:        The checksum that should be placed in the SLP
#                    packet footer.
#
########################################################################

sub CalcFooterChecksum
{
    my ($header, $body) = @_;

    my ($checksum, $temp_buffer);

    $temp_buffer = $header . $body;

    $checksum = unpack("%16c*", $temp_buffer);    # Wrong kind of checksum!
}


########################################################################
#
#    FUNCTION:        MakeRPCBody
#
#    DESCRIPTION:    Create the body of an RPC packet, suitable for
#                    being passed off to MakePacket.
#
#    PARAMETERS:        The "trap word" of the trap that needs to be called
#                    (as defined by the constants in SysTraps.pm) and
#                    the parameters of the RPC call, as created by the
#                    MakeParam function.
#
#    RETURNED:        The body of the packet as a string.
#
########################################################################

    #    struct SysPktRPCType
    #    {
    #        _sysPktBodyCommon;        // Common Body header
    #        Word    trapWord;        // which trap to execute
    #        DWord    resultD0;        // result from D0 placed here
    #        DWord    resultA0;        // result from A0 placed here
    #        Word    numParams;        // how many parameters follow
    #        // Following is a variable length array ofSlkRPCParamInfo's
    #        SysPktRPCParamType    param[1];
    #    };

$rpc_header_template    = "CxH4NNn";        # unsigned byte, filler, 4 hex digits, 2 B.E. longs, B.E. short
$sysPktRPCCmd            = 0x0A;
$sysPktRPCRsp            = 0x8A;

sub MakeRPCBody
{
    my ($trapword, $format, @param_list) = @_;

    my ($rpc_header) = pack ($rpc_header_template, $sysPktRPCCmd, $trapword, 0, 0, $#param_list + 1);
    my ($rpc_body) = join ("", $rpc_header, Marshal($format, @param_list));

    $rpc_body;
}

sub UnmakeRPCBody
{
    my ($body, $format) = @_;

    my ($cmd, $trap_word, $D0, $A0, $num_params, $packed_parms) = unpack ("$rpc_header_template a*", $body);
    my (@parms) = Unmarshal($packed_parms, $format);

    return ($D0, $A0, @parms);
}


$rpc2_header_template    = "CxH4NNN";        # unsigned byte, filler, 4 hex digits, 3 B.E. longs
$sysPktRPC2Cmd            = 0x20;
$sysPktRPC2Rsp            = 0xA0;

sub MakeRPC2Body
{
    my ($trapword, $reg_list, @param_list) = @_;

    my ($rpc_header) = pack ($rpc_header_template, $sysPktRPCCmd, $trapword, 0, 0, 0);
    my ($param_count) = pack ("n", $#param_list + 1);
    my ($rpc_body) = join ("", $rpc_header, $reg_list, $param_count, reverse @param_list);

    $rpc_body;
}


########################################################################
#
#    FUNCTION:        PackRegList
#
#    DESCRIPTION:    Pack a list of register values into the format
#                    needed by an RPC2 packet.
#
#    PARAMETERS:        An associative array, where each key contains Ax
#                    or Dx, and the value contains the register value.
#
#    RETURNED:        The packed registers as a string.
#
########################################################################

sub PackRegList
{
    my (%reg_list) = @_;

    my ($dreg_bits, $areg_bits, $dregs, $aregs);

    $dreg_bits = 0;
    $areg_bits = 0;
    $dregs = "";
    $aregs = "";

    foreach $key (sort keys %reg_list)
    {
        my($reg_space) = substr($key, 0, 1);
        my($bit_to_set) = (1 << (ord(substr($key, 1, 1)) - ord("0")));
        my($value) = $reg_list{$key};

        if ($reg_space eq "D")
        {
            $dreg_bits |= $bit_to_set;
            $dregs .= pack ("N", $value);
        }
        else
        {
            $areg_bits |= $bit_to_set;
            $aregs .= pack ("N", $value);
        }
    }

    my ($result) = join ("", pack("CC", $dreg_bits, $areg_bits), $dregs, $aregs);
}


########################################################################
#
#    FUNCTION:        MakeParam
#
#    DESCRIPTION:    Create a parameter array element, suitable for being
#                    added to other parameter array elements and --
#                    eventually -- to an RPC packet body.
#
#    PARAMETERS:        $data - the data to be added.
#                    $data_len - the length of the data to be added.  If
#                        greater than zero, then we assume $data to be
#                        an integer.  If equal to zero, then we assume
#                        data to be a string where the length of the
#                        string is determined by the length () function.
#                        If less than zero, then data is assumed to be
#                        a buffer with a length of -$data.
#                    $by_ref - zero if the parameter is to be treated as
#                        pass-by-value.  Non-zero if it's pass-by-ref.
#
#    RETURNED:        A parameter string that can be appended to a longer
#                    string of parameters.  If the length of the string
#                    would otherwise be odd, a padding byte is added.
#
########################################################################

    #    struct SysPktRPCParamInfo
    #    {
    #        Byte     byRef;            // true if param is by reference
    #        Byte    size;            // # of Bytes of paramData    (must be even)
    #        Word    data[1];        // variable length array of paramData
    #    };

sub ToParamBlock
{
    my ($data, $data_len) = @_;

    die "Undefined \$data, stopped" unless defined($data);
    die "\$data_len is negative, stopped" if ($data_len < 0);

    ## If data_len == 0, determine the length using the length () function.
    ## Else, use the given length.

    if ($data_len == 0)
    {
        $data_len = length ($data);
    }
    else
    {
        $data = pack ("a$data_len", $data);
    }

    ## Pack up the data.

    my ($param) = pack ("CC", 1, $data_len) . $data;

    ## Make sure the packed data is an even number of bytes long.

    if (($data_len % 2) != 0)
    {
        $param .= "\0";
    }

    $param;
}


sub FromParamBlock
{
    my ($param, $data_len) = @_;

    die "Undefined \$param, stopped" unless defined($param);
    die "\$data_len is negative, stopped" if ($data_len < 0);

    ## Just ignore the $data_len and use what's in the parameter block.

    $data_len = unpack ("xC", $param);

    unpack ("xxa$data_len", $param);
}


sub ToParamInt
{
    my ($data, $data_len, $by_ref) = @_;

    die "Undefined \$data, stopped" unless defined($data);

    my ($format);

    if ($data_len == 8)
    {
        $format = ("CCCx");
        $data_len = 1;
    }
    elsif ($data_len == 16 || $data_len == 0)
    {
        $format = ("CCn");
        $data_len = 2;
    }
    elsif ($data_len == 32)
    {
        $format = ("CCN");
        $data_len = 4;
    }
    else
    {
        die "\$data_len not 8, 16, or 32, stopped";
    }

    ## Pack up the data.

    pack ($format, $by_ref, $data_len, $data);
}


sub FromParamInt
{
    my ($param, $data_len) = @_;

    die "Undefined \$param, stopped" unless defined($param);

    my ($format);

    if ($data_len == 8)
    {
        $format = ("xxCx");
    }
    elsif ($data_len == 16 || $data_len == 0)
    {
        $format = ("xxn");
    }
    elsif ($data_len == 32)
    {
        $format = ("xxN");
    }
    else
    {
        die "\$data_len not 8, 16, or 32, stopped";
    }

    unpack ($format, $param);
}


sub ToParamPoint
{
    my ($point) = @_;
    my ($param);

    if (defined $point->{x})
    {
        $param = pack ("CCnn", 1, 4, $point->{x}, $point->{y});
    }
    else
    {
        $param = pack ("CCxxxx", 1, 4);
    }

    $param;
}


sub FromParamPoint
{
    my ($param) = @_;

    die "Undefined \$param, stopped" unless defined($param);

    my (@coords) = unpack ("xxnn", $param);

    {x    => $coords[0],
     y    => $coords[1]};
}


sub ToParamRect
{
    my ($rect) = @_;
    my ($param);

    if (defined $rect->{height})
    {
        $param = pack ("CCnnnn", 1, 8, $rect->{left}, $rect->{top}, $rect->{width}, $rect->{height});
    }
    elsif (defined $rect->{bottom})
    {
        $param = pack ("CCnnnn", 1, 8, $rect->{left}, $rect->{top}, $rect->{right} - $rect->{left}, $rect->{bottom} - $rect->{top});
    }
    else
    {
        $param = pack ("CCxxxxxxxx", 1, 8);
    }

    $param;
}


sub FromParamRect
{
    my ($param) = @_;

    die "Undefined \$param, stopped" unless defined($param);

    my (@coords) = unpack ("xxnnnn", $param);

    {left    => $coords[0],
     top    => $coords[1],
     width    => $coords[2],
     height    => $coords[3],
     right    => $coords[0] + $coords[2],
     bottom    => $coords[1] + $coords[3]};
}


sub ToParamString
{
    my ($data, $data_len) = @_;

    die "Undefined \$data, stopped" unless defined($data);
    die "\$data_len is negative, stopped" if ($data_len < 0);

    ## If $data_len == 0, determine the length using the length () function.

    if ($data_len == 0)
    {
        $data_len = length ($data) + 1;    # Add 1 to get 1 byte of NULL padding
    }

    ## Pack up the data.

    my ($param) = pack ("CCa$data_len", 1, $data_len, $data);

    ## Make sure the packed data is an even number of bytes long.

    if (($data_len % 2) != 0)
    {
        $param .= "\0";
    }

    $param;
}


sub FromParamString
{
    my ($param) = @_;

    unpack ("xxA*", $param);
}


########################################################################
#
#    FUNCTION:        UnpackHeader
#
#    DESCRIPTION:    Disassemble a packet header into its consituent
#                    parts.
#
#    PARAMETERS:        The packet header as received from Poser
#
#    RETURNED:        The signature, destination port, source port,
#                    packet type, body size, transaction ID, and
#                    checksum as an array.
#
########################################################################

sub UnpackHeader
{
    my($header) = @_;

    my ($signature, $dest, $src, $type, $bodySize, $transID, $checksum)
        = unpack ($header_template, $header);

    ($signature, $dest, $src, $type, $bodySize, $transID, $checksum);
}


########################################################################
#
#    FUNCTION:        GetBodySize
#
#    DESCRIPTION:    Utility function to extract the packet body size
#                    field from the packet header.
#
#    PARAMETERS:        The packet header as received from Poser.
#
#    RETURNED:        The size of the body following the header.
#
########################################################################

sub GetBodySize
{
    my($header) = @_;

    my ($signature, $dest, $srs, $type, $bodySize, $transID, $checksum)
        = UnpackHeader ($header);

    $bodySize;
}


sub SkipWhite
{
    my ($format, $format_index) = @_;

    while ()
    {
        last if ($format_index >= length ($format));

        my ($char) = substr ($format, $format_index, 1);
        last unless ($char eq " " || $char eq "," || $char eq ":");

        $format_index += 1;
    }

    $format_index
}


sub GetType
{
    my ($format, $format_index) = @_;
    my ($type) = "";

    $format_index = SkipWhite ($format, $format_index);

    while ()
    {
        last if ($format_index >= length ($format));

        my ($char) = substr ($format, $format_index, 1);
        last if (($char lt "a" || $char gt "z") && ($char lt "A" || $char gt "Z"));

        $type .= $char;
        $format_index += 1;
    }

    die "Unknown type (\"$type\" @ $format_index), stopped"
        unless ($type eq "int" ||
                $type eq "Err" ||
                $type eq "Coord" ||
                $type eq "LocalID" ||
                $type eq "HostErr" ||
                $type eq "string" ||
                $type eq "rptr" ||
                $type eq "point" ||
                $type eq "rect" ||
                $type eq "block");

    return ($type, $format_index);
}


sub GetSize
{
    my ($format, $format_index) = @_;
    my ($size) = 0;

    while ()
    {
        last if ($format_index >= length ($format));

        my ($char) = substr ($format, $format_index, 1);
        last if ($char lt "0" || $char gt "9");

        $size = $size * 10 + $char;
        $format_index += 1;
    }

    return ($size, $format_index);
}


sub GetByRef
{
    my ($format, $format_index) = @_;
    my ($by_ref) = 0;

    if (substr ($format, $format_index, 1) eq "*")
    {
        $by_ref = 1;
    }

    if ($by_ref)
    {
        $format_index += 1;
    }

    return ($by_ref, $format_index);
}


sub GetFormat
{
    my ($format, $format_index) = @_;
    my ($type, $size, $by_ref) = (" ", 0, 0);

    ($type, $format_index) = GetType ($format, $format_index);
    ($size, $format_index) = GetSize ($format, $format_index);
    ($by_ref, $format_index) = GetByRef ($format, $format_index);

    ## Deal with aliases

    if ($type eq "LocalID" or $type eq "HostErr")
    {
        $type = "int";
        $size = 32;
    }
    elsif ($type eq "Err" or $type eq "Coord")
    {
        $type = "int";
        $size = 16;
    }

    return ($type, $size, $by_ref, $format_index);
}


sub Marshal
{
    my ($format, @parameters) = @_;
    my (@result);

    my ($format_index) = 0;
    my ($parameter_index) = 0;

    while ($format_index < length ($format))
    {
        my ($parm);

        my ($type, $size);
        ($type, $size, $by_ref, $format_index) = GetFormat ($format, $format_index);

        if ($type eq "int")
        {
            $parm = EmRPC::ToParamInt($parameters[$parameter_index], $size, $by_ref);
        }
        elsif ($type eq "rptr")
        {
            $parm = EmRPC::ToParamInt($parameters[$parameter_index], 32, 0);
        }
        elsif ($type eq "point")
        {
            $parm = EmRPC::ToParamPoint($parameters[$parameter_index], $size);
        }
        elsif ($type eq "rect")
        {
            $parm = EmRPC::ToParamRect($parameters[$parameter_index], $size);
        }
        elsif ($type eq "string")
        {
            $parm = EmRPC::ToParamString($parameters[$parameter_index], $size);
        }
        elsif ($type eq "block")
        {
            $parm = EmRPC::ToParamBlock($parameters[$parameter_index], $size);
        }
        else
        {
            die "Unexpected type \"$type\" in EmRPC::Marshal, stopped";
        }

        push (@result, $parm);

        $parameter_index += 1;
    }

    return join ("", reverse @result);
}


sub BreakApartParameters
{
    my ($packed_parms) = @_;
    my (@result) = 0;

    my ($offset) = 0;

    while ($offset < length ($packed_parms))
    {
        # Get the size field.

        my ($size) = unpack ("x$offset" . "xC", $packed_parms);

        # Add in the lengths of the byRef and size fields.

        $size += 2;

        # Make sure the field is word-aligned.

        if (($size % 2) != 0)
        {
            $size += 1;
        }

        # Get the SysPktRPCParamInfo.

        my ($parm) = unpack ("x$offset a$size", $packed_parms);

        push (@result, $parm);

        $offset += $size;
    }

    return @result;
}


sub Unmarshal
{
    my ($packed_parms, $format) = @_;
    my (@result);

    my ($format_index) = 0;
    my ($parameter_index) = 0;

    my (@parameters) = reverse BreakApartParameters($packed_parms);

    while ($format_index < length ($format))
    {
        my ($parm);

        my ($type, $size);
        ($type, $size, $by_ref, $format_index) = GetFormat ($format, $format_index);

        if ($type eq "int")
        {
            $parm = EmRPC::FromParamInt($parameters[$parameter_index], $size);
        }
        elsif ($type eq "rptr")
        {
            $parm = EmRPC::FromParamInt($parameters[$parameter_index], 32);
        }
        elsif ($type eq "point")
        {
            $parm = EmRPC::FromParamPoint($parameters[$parameter_index]);
        }
        elsif ($type eq "rect")
        {
            $parm = EmRPC::FromParamRect($parameters[$parameter_index]);
        }
        elsif ($type eq "string")
        {
            $parm = EmRPC::FromParamString($parameters[$parameter_index]);
        }
        elsif ($type eq "block")
        {
            $parm = EmRPC::FromParamBlock($parameters[$parameter_index], $size);
        }
        else
        {
            die "Unexpected type \"$type\" in EmRPC::Unmarshal, stopped";
        }

        push (@result, $parm);

        $parameter_index += 1;
    }

    return @result;
}


sub ReadString
{
    my ($address) = @_;

    my ($block) = EmRPC::ReadBlock($address, 128);

    my ($string, $ch);

    foreach $ii (0..length ($block) - 1)
    {
        $ch = substr($block, $ii, 1);
        last if (ord($ch) == 0);
        $string .= $ch;
    }

    $string;
}


sub PrintString
{
    my($string) = @_;

    foreach $ii (0..length ($string) - 1)
    {
        my($ch) = substr($string, $ii, 1);

        printf "0x%02X, ", ord($ch);

        if ($ii % 8 == 7)
        {
            print "\n";
        }
    }

    printf "\n";

    $string;
}

1;