HTTP requests over SSL in Poly/ML

Makefile

.PHONY: all

all:
        gcc -shared -fPIC -o ssl.so -lcrypto -lssl ssl.c
        polyc ssl.sml

ssl.c

#include <stdio.h>                                                                                                                                                                                 [21/1808]
#include <openssl/ssl.h>

SSL_CTX *ssl_ctx;

SSL *ssl_wrap (int sock) {
  SSL_load_error_strings();
  SSL_library_init();
  ssl_ctx = SSL_CTX_new(SSLv23_client_method());
  SSL *conn = SSL_new(ssl_ctx);
  SSL_set_fd(conn, sock);
  int r = -1;
  while (r < 0) {
      r = SSL_connect(conn);
  }
  SSL_set_mode(conn, SSL_MODE_AUTO_RETRY);
  return conn;
}

int ssl_write (SSL *conn, const char *req, int length) {
  int w = SSL_write(conn, req, length);                                                                                                                                                                       if (w < 0) {                                                                                                                                                                                                  int ssl_error = SSL_get_error(conn, w);                                                                                                                                                                     if (ssl_error == SSL_ERROR_WANT_WRITE) {
      fprintf(stderr, "SSL_write wants write\n");
      return w;
    }

    if (ssl_error == SSL_ERROR_WANT_READ) {
      fprintf(stderr, "SSL_write wants read\n");
      return w;
    }

    long error = ERR_get_error();
    const char* error_string = ERR_error_string(error, NULL);
    fprintf(stderr, "could not SSL_write (returned -1): %s\n", error_string);
    return w;
  }
}

int ssl_read(SSL *conn, void* buf, int length) {
  int read = SSL_read(conn, buf, length);
  if (read < 0) {
    int ssl_error = SSL_get_error(conn, read);
    if (ssl_error == SSL_ERROR_WANT_WRITE) {
      fprintf(stderr, "SSL_read wants write\n");
            return read;
    }

    if (ssl_error == SSL_ERROR_WANT_READ) {
      fprintf(stderr, "SSL_read wants read\n");
      return read;
    }

    long error = ERR_get_error();
    const char* error_string = ERR_error_string(error, NULL);
    fprintf(stderr, "could not SSL_read (returned -1) %s\n", error_string);
    return read;
  }
}

void ssl_close(SSL *conn) {
  SSL_shutdown(conn);
  SSL_free(conn);
  SSL_CTX_free(ssl_ctx);
}

ssl.sml

fun socketToInt s =
    SysWord.toInt (Posix.FileSys.fdToWord (valOf (Posix.FileSys.iodToFD (Socket.ioDesc s))))

fun intToSocket fd =
    Posix.FileSys.fdToIOD (Posix.FileSys.wordToFD (SysWord.fromInt fd))

open CInterface

val get = get_sym "./ssl.so";

val sslWrap = call1 (get "ssl_wrap") INT POINTER;
fun sslWrite (s, r) = call3 (get "ssl_write") (POINTER, STRING, INT) INT (s, r, size r);
fun sslRead s =
    let
        val buf = alloc 1024 Cchar
        fun readBuf buf 0 = []
          | readBuf buf n = fromCchar buf :: readBuf (offset 1 Cchar buf) (n - 1)

        val read = call3 (get "ssl_read") (POINTER, POINTER, INT) INT (s, address buf, 1024);
    in
        (read, if read <= 0 then "" else implode (readBuf buf 1024))
    end
val sslClose = call1 (get "ssl_close") POINTER VOID;

exception E of string

fun request domain path =
    let
        val req = "GET " ^ path ^ " HTTP/1.1\r\nHost: " ^ domain ^ "\r\n\r\n";
        val socket = INetSock.TCP.socket ();
        val address =
            let
                val SOME entry = NetHostDB.getByName domain;
            in
                INetSock.toAddr (NetHostDB.addr entry, 443)
            end;
        val written = ref ~1;
        val read = ref 0;
        val rsp = ref "";
        val _ = Socket.connect (socket, address);
        val sslSocket = sslWrap (socketToInt socket);
    in
        while !written < 0 do written := sslWrite (sslSocket, req);
        print (req);
        while (!read > 0 orelse !rsp = "") do
            let
                val (readTmp, tmp) = sslRead (sslSocket);
                val len = size tmp;
            in
                read := readTmp;
                rsp := !rsp ^ tmp
            end;
        print (!rsp);
        sslClose (sslSocket);
        Socket.close (socket)
    end

fun main() = request "api.alpha.linode.com" "/v4/datacenters"