Simple Static File Server in Reason/OCaml

BasicServer.re

let recv = (client, maxlen) => {
  let bytes = Bytes.create(maxlen);
  let len = Unix.recv(client, bytes, 0, maxlen, []);
  Bytes.sub_string(bytes, 0, len)
};

let parse_top = top => {
  let parts = Str.split(Str.regexp("[ \t]+"), top);
  switch (parts) {
  | [method, path, ...others] => Some((method, path))
  | _ => None
  }
};

module StringMap = Map.Make(String);

let parse_headers = headers => {
  List.fold_left(
    (map, line) => {
      let parts = Str.split(Str.regexp(":"), line);
      switch parts {
      | [] | [_] => map
      | [name, ...rest] => StringMap.add(name, String.concat(":", rest), map)
      }
    },
    StringMap.empty,
    headers
  )
};

let parse_request = text => {
  let items = Str.split(Str.regexp("\r?\n"), text);
  switch items {
  | [] => failwith("Invalid request")
  | [top, ...headers] =>
  switch (parse_top(top)) {
  | None => failwith("Invalid top: " ++ top)
  | Some((method, path)) =>
  let header_map = parse_headers(headers);
  (method, path, header_map)
  }
  }
};

module Response = {
  type response =
    | Ok(string, string) /* mime, text */
    | Bad(int, string); /* code, text */
};
open Response;

let format_response = response => {
  let (top, body) = switch (response) {
  | Ok(mime, body) => {
    ("HTTP/1.1 200 Ok\nContent-type: " ++ mime, body)
  }
  | Bad(code, body) => {
    ("HTTP/1.1 " ++ string_of_int(code) ++ " Error\nContent-type: text/plain", body)
  }
  };
  top ++ "\nServer: Ocaml-Cross-Mobile\nContent-length: " ++ string_of_int(String.length(body)) ++ "\n\n" ++ body
};

let listen = (port, handler) => {
  let sock = Unix.socket(Unix.PF_INET, Unix.SOCK_STREAM, 0);
  Unix.setsockopt(sock, Unix.SO_REUSEADDR, true);
  Unix.bind(sock, Unix.ADDR_INET(Unix.inet_addr_any, port));
  print_endline("Listening! Open http://localhost:" ++ string_of_int(port));

  while (true) {
    Unix.listen(sock, 1000);
    let (client, source) = Unix.accept(sock);
    let request = recv(client,  1024);
    let response = try {
      let (method, path, header_map) = parse_request(request);
      print_endline("Request for: " ++ path);

      handler(method, path, header_map);
    } {
      | _ => Bad(500, "Server error")
    };

    let response = format_response(response);
    let total = String.length(response);
    let left = ref(String.length(response));
    while (left^ > 0) {
      left := left^ - Unix.send(client, response, total - left^, left^, []);
    };
    Unix.shutdown(client, Unix.SHUTDOWN_ALL);
  }
};

StaticServer.re

let readall = (fd) => {
  let rec loop = () => switch (Pervasives.input_line(fd)) {
  | exception End_of_file => []
  | line => [line, ...loop()]
  };
  loop();
};

let exists = path => try {Unix.stat(path) |> ignore; true} {
| Not_found => false
};

let readFile = path => {
  let fd = Unix.openfile(path, [Unix.O_RDONLY], 0o640);
  let text = String.concat("\n", readall(Unix.in_channel_of_descr(fd)));
  Unix.close(fd);
  text
};

let mime_for_name = ext => switch (String.lowercase(ext)) {
| "txt" => "text/plain"
| "html" => "text/html"
| "json" => "text/json"
| "js" => "application/javascript"
| "jpg" | "jpeg" => "image/jpeg"
| "png" => "image/png"
| "pdf" => "image/pdf"
| "ico" => "image/ico"
| "gif" => "image/gif"
| _ => "application/binary"
};

let ext = path => {
  let parts = Str.split(Str.regexp("\\."), path);
  List.nth(parts, List.length(parts) - 1)
};

let isFile = path => switch (Unix.stat(path)) {
| exception Unix.Unix_error(Unix.ENOENT, _, _) => false
| {Unix.st_kind: Unix.S_REG} => true
| _ => false
};

open BasicServer.Response;
let serveStatic = (full_path, path) => {
  switch (Unix.stat(full_path)) {
  | exception Unix.Unix_error(Unix.ENOENT, _, _) => Bad(404, "File not found: " ++ path)
  | stat =>
  switch (stat.Unix.st_kind) {
  | Unix.S_REG => Ok(mime_for_name(ext(path)), readFile(full_path))
  | Unix.S_DIR => {
    let index = Filename.concat(full_path, "index.html");
    if (isFile(index)) {
      Ok("text/html", readFile(index))
    } else {
      Ok("text/plain", "Directory")
    }
  }
  | _ => Bad(404, "Unexpected file type: " ++ path)
  };
  }
};

let handler = (base, method, path, headers) => {
  switch (method) {
  | "GET" => {
    let full_path = Filename.concat(base, "." ++ path);
    serveStatic(full_path, path)
  }
  | _ => Bad(401, "Method not allowed: " ++ method)
  }
};

let main = () => {
  switch (Sys.argv) {
  | [|_|] => BasicServer.listen(3451, handler("./"))
  | [|_, path|] => BasicServer.listen(3451, handler(path))
  | _ => print_endline("Usage: serve [path: default current]")
  }
};

main();