#!/usr/bin/perl -w
######################################################################
# SetLAA - a short script to set the Large Address Aware flag on a
# WIN32 EXE, (C) Copyright 2024 Nosey Nick Waterman,
#   <perl@noseynick.org>   https://noseynick.org/artemis/
# All wrong righted, all rights reserved. Licensed under the GNU
# Affero General Public License v3.0 https://www.gnu.org/licenses/agpl.txt
# with Commons Clause https://commonsclause.com/ v1.0
######################################################################
# +++ consider -T for taint checks?
# +++ consider Perl::Critic
# +++ consider Smart::Comments
# +++ podchecker <this file>
use 5.008;
use strict;
use warnings;
our $VERSION = 0.01;

=head1 NAME

SetLAA.pl - Set /LargeAddressAware flag on a Windows PE32 EXE

=head1 SYNOPSIS

  SetLAA.pl filename.exe

=head1 DESCRIPTION

B<SetLAA.pl> will B<modify the specified Windoes PE EXE> to enable the
/LargeAddressAware flag, to support >2GB of memory.

=head1 EXAMPLES

  SetLAA.pl Artemis.exe
  # Artemis.EXE may now support up to 4GB of memory,
  # rather than being limited to 2GB

=head1 NOTES

Parents of young, organic life forms are warned that towels can be
harmful if swallowed in large quantities -- DNA, H2G2

=head1 AUTHOR

"Nosey" Nick Waterman of Nilex
E<lt>perl@noseynick.orgE<gt>  L<https://noseynick.org/>

=head1 COPYRIGHT

(C) Copyright 2024 Nosey Nick Waterman,
E<lt>perl@noseynick.orgE<gt>   https://noseynick.org/artemis/
All wrong righted, all rights reserved. Licensed under the GNU
Affero General Public License v3.0 https://www.gnu.org/licenses/agpl.txt
with Commons Clause https://commonsclause.com/ v1.0

=cut

my $fn = shift or die "USAGE: $0 FILENAME.exe\n";
open(EXE, "+< :raw :bytes", $fn)
  or die "Unable to open $fn for R/W: $!\n";
print "#"x70, "\n# Editing $fn ...\n";

# Generic file reading helper:
sub check {
    my ($buf, $off, $len, $what, $unpack, $expect, $nonfatal) = ("", @_);
    seek(EXE, $off, 0)
      or die "Unable to seek to $off for $what - broken EXE?: $!\n";
    read(EXE, $buf, $len) == $len
      or die "Unable to read $what?!?: $!\n";
    ($buf) = unpack($unpack, $buf) if $unpack;
    if      ($expect && $buf eq $expect) {
        printf "# (0x%x) ... has good %s\n", $off, $what;
    } elsif ($expect and $nonfatal) {
        printf "# (0x%x) Got 0x%x %s expected 0x%x %s CONTINUING ANYWAY\n",
          $off, $buf, $what, $expect, $nonfatal;
    } elsif ($expect) {
        die "($off) $what is wrong?!?\n";
    }
    return $buf;
}

# Check MS-DOS header
check(0, 2, "MS-DOS header", "", "MZ");

# Find PE header offset
my $pe_off = check(0x3C, 4, "PE offset", "V");
printf "# (0x3c) 0x%04x = %d PE offset\n", $pe_off, $pe_off;

# Check PE header
check($pe_off, 4, "PE signature", "", "PE\0\0");

# Check Machine type
check($pe_off+4, 2, "PE Machine type", "v", 0x14c, "Intel 386");

# Check Characteristics :
my $char = check($pe_off+22, 2, "Characteristics", "v", 0x0102, "(below)");
printf "# (0x%x) 0x%04x = %d Characteristics\n", $pe_off+22, $char, $char;
# Set LAA:
$char |= 0x0020;
printf "# (0x%x) 0x%04x = %d NEW Characteristics\n", $pe_off+22, $char, $char;

# Write it back!
seek(EXE, $pe_off+22, 0)
  or die "Unable to seek to $pe_off+22 - broken EXE?: $!\n";
print EXE pack("v", $char)
  or die "Unable to write back NEW Characteristics: $!\n";
print "# Written!\n";

######################################################################
# Now IN THEORY there's also a checksum which needs to be recalculated
# "hte" editor Calls this "PE header / optional header: NT fields /
# checksum" (and can recalculate it). The algo seems to be:
# Add up all the 16-bit (unpack("v")) ints in the file, EXCEPT the
# chcksum itself. Add 1 each time it overflows 16 bits. Lastly, treat
# it as a 32-bit int and add the FILE LENGTH
# Thankfully IN PRACTICE, neither Windows nor WINE seem to actually
# care about this checksum... Therefore this script ignores it   :-)
######################################################################

close EXE or die "Failed to close: $!\n";
exit 0; # if we got here OK!