Below is the file 'crypto/ocaml-openssl.c' from this revision. You can also download the file.

#include <sys/types.h>

#include <openssl/rc4.h>
#include <openssl/sha.h>
#include <openssl/rsa.h>
#include <openssl/x509.h>
#include <openssl/objects.h>
#include <openssl/err.h>

#define CAML_NAME_SPACE

#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/memory.h>
#include <caml/fail.h>
#include <caml/custom.h>
#include <caml/callback.h>

#define UString_val(s) ((unsigned char *) (s))
#define block_size(s) (((s) - 1) / sizeof (value) + 1)

#define RC4_val(v) ((RC4_KEY *)(v))

CAMLprim value
ml_RC4_set_key (value s)
{
  CAMLparam1 (s);
  value k;

  k = caml_alloc_small (block_size (sizeof (RC4_KEY)), Abstract_tag);
  RC4_set_key (RC4_val (k), caml_string_length (s), UString_val (s));
  CAMLreturn (k);
}

CAMLprim value
ml_RC4 (value key, value in_s, value out_s)
{
  size_t len;
  len = caml_string_length (in_s);
  if (caml_string_length (out_s) != len)
    caml_invalid_argument ("Crypto.rc4: string sizes differ");
  RC4 (RC4_val (key), len, UString_val (in_s), UString_val (out_s));
  return Val_unit;
}

CAMLprim value
ml_SHA1 (value msg)
{
  CAMLparam1 (msg);
  value o;
  o = caml_alloc_string (SHA_DIGEST_LENGTH);
  SHA1 (UString_val (msg), caml_string_length (msg), UString_val (o));
  CAMLreturn (o);
}

#define RSA_val(v) (*(RSA **) Data_custom_val(v))

static void
ml_rsa_finalize (value v)
{
  RSA_free (RSA_val (v));
}

static struct custom_operations ml_rsa = {
  "ocaml-rsa",
  ml_rsa_finalize,
  custom_compare_default,
  custom_hash_default,
  custom_serialize_default,
  custom_deserialize_default
};

static value
wrap_RSA_key (RSA *key)
{
  value v;
  RSA **s;
  v = caml_alloc_custom (&ml_rsa, sizeof key, 1, 100);
  s = Data_custom_val (v);
  *s = key;
  return v;
}

static void
ml_crypto_error (char *fun)
{
#if 0
  static int init;
  if (! init)
    {
      ERR_load_crypto_strings ();
      init = 1;
    }
  ERR_print_errors_fp (stderr);
#endif
  caml_failwith (fun);
}

CAMLprim value
ml_d2i_RSA_PUBKEY (value s)
{
  const unsigned char *p;
  RSA *r_key;

  p = UString_val (s);
  r_key = NULL;
  if (! d2i_RSA_PUBKEY (&r_key, &p, caml_string_length (s)))
    ml_crypto_error ("d2i_RSA_PUBKEY");

  return wrap_RSA_key (r_key);
}

CAMLprim value
ml_d2i_PKCS8_RSA_PrivateKey (value s)
{
  const unsigned char *p;
  PKCS8_PRIV_KEY_INFO *p_key;
  EVP_PKEY *e_key;
  RSA *r_key;

  p = UString_val (s);
  p_key = NULL;
  if (! d2i_PKCS8_PRIV_KEY_INFO (&p_key, &p, caml_string_length (s)))
    ml_crypto_error ("d2i_PKCS8_PRIV_KEY_INFO");

  e_key = EVP_PKCS82PKEY (p_key);
  if (e_key == NULL)
    {
      PKCS8_PRIV_KEY_INFO_free (p_key);
      ml_crypto_error ("EVP_PKCS82PKEY");
    }

  r_key = EVP_PKEY_get1_RSA (e_key);

  PKCS8_PRIV_KEY_INFO_free (p_key);
  EVP_PKEY_free (e_key);

  if (r_key == NULL)
    ml_crypto_error ("EVP_PKEY_get1_RSA");

  return wrap_RSA_key (r_key);
}

CAMLprim value
ml_RSA_size (value key)
{
  return Val_int (RSA_size (RSA_val (key)));
}

static int
NID_of_dtype (value d_type)
{
  static const int nids[] = { NID_sha1 };
  return nids[ Int_val (d_type) ];
}

CAMLprim value
ml_RSA_sign (value key, value d_type, value md, value sig)
{
  unsigned int siglen;
  if (! RSA_sign (NID_of_dtype (d_type),
		  UString_val (md), caml_string_length (md),
		  UString_val (sig), &siglen,
		  RSA_val (key)))
    ml_crypto_error ("RSA_sign");
  return Val_int (siglen);
}

CAMLprim value
ml_RSA_verify (value key, value d_type, value md, value sig)
{
  return Val_bool (RSA_verify (NID_of_dtype (d_type),
			       UString_val (md), caml_string_length (md),
			       UString_val (sig), caml_string_length (sig),
			       RSA_val (key)));
}