#!/usr/bin/perl
# $Id: mach-o.pl,v 1.0 92/07/31 17:39:42 cap Exp $
# Utility functions for reading and writing Mach-O files
#
# constants from include files
$LC_SEGMENT = 1;	# segment of file to be mapped

$sizeof_mach_header = 4 + 4*2 + 4*4;
sub read_mach_header {
    local($handle) = @_;
    local($buf);

    seek($handle, 0, 0);
    read($handle, $buf, $sizeof_mach_header);
#   ($magic, $cputype, $cpusubtype, $filetype, $ncmds, $sizeofcmds, $flags) = 
    unpack("Li2L4", $buf);
}

#
# peek a load command, which is presumably at the current file pointer location
# This returns the command type and size, and then seeks back to before
# where it read.
$sizeof_load_command = 4 + 4;
sub peek_load_command {
    local($handle) = @_;
    local($buf);

    read($handle, $buf, $sizeof_load_command);
    seek($handle, -$sizeof_load_command, 1);	# back up
#   ($cmd, $cmdsize) = 
    unpack("L2", $buf);
}

#
# Read and return a segment command
$sizeof_segment_command = 4*2 + 16 + 4*8;
sub read_segment_command {
    local($handle) = @_;
    local($buf);

    read($handle, $buf, $sizeof_segment_command);
#   ($cmd, $cmdsize, $segname, $vmaddr, $vmsize, $fileoff, $filesize,
#    $maxprot, $initprot, $nsects, $flags) =
    unpack("L2A16L4i2L2", $buf);
}

#
# seek past a segment, whose segment_command we've already read
# You pass in the file handle and cmdsize of the segment
sub seek_past_segment_command {
    local($handle, $cmdsize) = @_;

    seek($handle, $cmdsize - $sizeof_segment_command, 1);
}

# the segment structure is passed in as the arguments, and 
# the structure is written at the current file pointer, leaving
# the file pointer after the structure
sub write_segment_command {
    local($handle, @structure) = @_;
    local($buf);

    $buf = pack("L2a16L4i2L2", @structure);
    print $handle $buf;
};

#
# Read and return a section command
$sizeof_section_command = 16 + 16 + 4*9;
sub read_section_command {
    local($handle) = @_;
    local($buf);

    read($handle, $buf, $sizeof_section_command);
#   struct section {
#	char            sectname[16];   /* name of this section */
#	char            segname[16];    /* segment this section goes in */
#	unsigned long   addr;           /* memory address of this section */
#	unsigned long   size;           /* size in bytes of this section */
#	unsigned long   offset;         /* file offset of this section */
#	unsigned long   align;          /* section alignment (power of 2)*/
#	unsigned long   reloff;         /* file offset of relocation entries */
#	unsigned long   nreloc;         /* number of relocation entries */
#	unsigned long   flags;          /* flags (i.e. zero fill section, etc)*/
#	unsigned long   reserved1;      /* reserved */
#	unsigned long   reserved2;      /* reserved */
#   };
    unpack("A16A16L9", $buf);
}

# There's no support for reading fvmlib, fvmlib_command, thread_command,
# symtab_command, symseg_command, and ident_command information,
# because I don't need that stuff.

## Now some higher-level functions

# this finds a segment, reads and returns its information structure,
# and leaves the file pointer right after the structure

sub segment_info {
    local($handle, $seg) = @_;
    local($magic, $cputype, $cpusubtype, $filetype, $ncmds, $sizeofcmds, 
	$flags);
    local($cmdnum, @seginfo);

    seek($handle, 0, 0);
    ($magic, $cputype, $cpusubtype, $filetype, $ncmds, $sizeofcmds, $flags) = 
	&read_mach_header($handle);
SEGMENTS:
    for ($cmdnum = 0; $cmdnum < $ncmds; $cmdnum++) {
        # read the load_command struct
        ($cmd, $cmdsize) = &peek_load_command($handle);

        if ($cmd != $LC_SEGMENT) {
	    seek($section, $cmdsize, 1);	# skip this command
        } else {
            @seginfo = &read_segment_command($handle);
	    if (@seginfo[2] ne $seg) {
	        # skip to next command
	        &seek_past_segment_command($handle, $cmdsize);
            } else {
		last SEGMENTS;
	    }
	}
    }
    @seginfo;
}

# section_info
# This leaves the file pointer right after the found section structure,
# or after the last section or command if the requested information wasn't
# found
sub section_info {
    local($handle, $sect, $seg) = @_;
    local($magic, $cputype, $cpusubtype, $filetype, $ncmds, $sizeofcmds, 
	$flags);
    local($cmdnum, @sectinfo);

    seek($handle, 0, 0);
    ($magic, $cputype, $cpusubtype, $filetype, $ncmds, $sizeofcmds, $flags) = 
	&read_mach_header($handle);
SEGMENTS:
    for ($cmdnum = 0; $cmdnum < $ncmds; $cmdnum++) {
        # read the load_command struct
        ($cmd, $cmdsize) = &peek_load_command($handle);

        if ($cmd != $LC_SEGMENT) {
	    seek($section, $cmdsize, 1);	# skip this command
        } else {
            ($cmd, $cmdsize, $segname, $vmaddr, $vmsize, $fileoff, $filesize,
             $maxprot, $initprot, $nsects, $flags) =
		 &read_segment_command($handle);

            if ($segname ne $seg) {
	        # skip to next command
	        &seek_past_segment_command($handle, $cmdsize);
            } else {
	        for ($sectnum = 0; $sectnum < $nsects; $sectnum++) {
		    @sectinfo = &read_section_command($handle);
		    last SEGMENTS if (@sectinfo[0] eq $sect);
	        }
	    }
        }
    }
    @sectinfo;
}
