SEXP PKI_digest(SEXP what, SEXP sMD) {
    SEXP res;
    unsigned char hash[32]; /* really, at most 20 bytes are needed */
    int len, md = asInteger(sMD);
    if (TYPEOF(what) != RAWSXP)
	Rf_error("what must be a raw vector");
    switch (md) {
    case PKI_SHA1:
	SHA1((const unsigned char*) RAW(what), LENGTH(what), hash);
	len = SHA_DIGEST_LENGTH;
	break;
    case PKI_MD5:
	MD5((const unsigned char*) RAW(what), LENGTH(what), hash);
	len = MD5_DIGEST_LENGTH;
	break;
    default:
	Rf_error("unsupported hash function");
	len = 0; /* dead code but needed to appease compilers */
    }
    res = allocVector(RAWSXP, len);
    memcpy(RAW(res), hash, len);
    return res;
}

SEXP PKI_load_public_RSA(SEXP what) {
    EVP_PKEY *key;
    RSA *rsa = 0;
    const unsigned char *ptr;
    if (TYPEOF(what) != RAWSXP)
	Rf_error("key must be a raw vector");
    ptr = (const unsigned char *) RAW(what);
    rsa = d2i_RSA_PUBKEY(&rsa, &ptr, LENGTH(what));
    if (!rsa)
	Rf_error("%s", ERR_error_string(ERR_get_error(), NULL));
    key = EVP_PKEY_new();
    EVP_PKEY_assign_RSA(key, rsa);
    return wrap_EVP_PKEY(key, PKI_KT_PUBLIC);
}

SEXP R_gpg_import(SEXP pubkey) {
  gpgme_data_t KEY;
  bail(gpgme_data_new_from_mem(&KEY, (const char*) RAW(pubkey), LENGTH(pubkey), 0), "creating key buffer");
  bail(gpgme_op_import(ctx, KEY), "importing pubkey");
  gpgme_import_result_t result = gpgme_op_import_result(ctx);
  SEXP out = PROTECT(allocVector(INTSXP, 5));
  INTEGER(out)[0] = result->considered;
  INTEGER(out)[1] = result->imported;
  INTEGER(out)[2] = result->secret_imported;
  INTEGER(out)[3] = result->new_signatures;
  INTEGER(out)[4] = result->new_revocations;
  UNPROTECT(1);
  return out;
}

SEXP R_ring_buffer_tail_offset(SEXP extPtr, SEXP r_offset) {
  size_t offset = INTEGER(r_offset)[0];
  ring_buffer * buffer = ring_buffer_get(extPtr, 1);
  SEXP ret = PROTECT(allocVector(RAWSXP, buffer->stride));
  data_t *data = (data_t*) ring_buffer_tail_offset(buffer, offset);
  if (data == NULL) {
    Rf_error("Buffer underflow");
  }
  memcpy(RAW(ret), data, buffer->stride);
  UNPROTECT(1);
  // NOTE: In C we return the tail position here but that is not done
  // for the R version.
  return ret;
}

static int
bind_params_to_stmt(RSQLiteParams* params,
                    sqlite3_stmt* db_statement, int row) {
  int state = SQLITE_OK, j;
  for (j = 0; j < params->count; j++) {
    SEXP pdata = VECTOR_ELT(params->data, j), v_elt;
    int integer;
    double number;
    Rbyte* raw;

    switch (TYPEOF(pdata)) {
      case INTSXP:
        integer = INTEGER(pdata)[row];
        if (integer == NA_INTEGER)
          state = sqlite3_bind_null(db_statement, j + 1);
        else
          state = sqlite3_bind_int(db_statement, j + 1, integer);
        break;
      case REALSXP:
        number = REAL(pdata)[row];
        if (ISNA(number))
          state = sqlite3_bind_null(db_statement, j + 1);
        else
          state = sqlite3_bind_double(db_statement, j + 1, number);
        break;
      case VECSXP:            /* BLOB */
        v_elt = VECTOR_ELT(pdata, row);
        if (v_elt == R_NilValue) {
          state = sqlite3_bind_null(db_statement, j + 1);
        } else {
          raw = RAW(v_elt);
          state = sqlite3_bind_blob(db_statement, j + 1,
              raw, LENGTH(v_elt), SQLITE_STATIC);
        }
        break;
      case STRSXP:
        /* falls through */
      default:
        v_elt = STRING_ELT(pdata, row);
        if (NA_STRING == v_elt)
          state = sqlite3_bind_null(db_statement, j + 1);
        else
          state = sqlite3_bind_text(db_statement, j + 1,
              CHAR(v_elt), -1, SQLITE_STATIC);
        break;
    }
    if (state != SQLITE_OK) break;
  }
  return state;
}

SEXP PKI_digest(SEXP sWhat, SEXP sMD) {
    SEXP res;
    unsigned char hash[32]; /* really, at most 20 bytes are needed */
    int len, md = asInteger(sMD);
    const unsigned char *what;
    int what_len;
    PKI_init();
    if (TYPEOF(sWhat) == RAWSXP) {
	what = (const unsigned char*) RAW(sWhat);
	what_len = LENGTH(sWhat);
    } else if (TYPEOF(sWhat) == STRSXP) {
	if (LENGTH(sWhat) < 1) return allocVector(RAWSXP, 0); /* good? */
	what = (const unsigned char*) CHAR(STRING_ELT(sWhat, 0));
	what_len = strlen((const char*) what);
    } else
	Rf_error("what must be a string or a raw vector");
    switch (md) {
    case PKI_SHA1:
	SHA1(what, what_len, hash);
	len = SHA_DIGEST_LENGTH;
	break;
    case PKI_SHA256:
  SHA256(what, what_len, hash);
  len = SHA256_DIGEST_LENGTH;
  break;
    case PKI_MD5:
	MD5(what, what_len, hash);
	len = MD5_DIGEST_LENGTH;
	break;
    default:
	Rf_error("unsupported hash function");
	len = 0; /* dead code but needed to appease compilers */
    }
    res = allocVector(RAWSXP, len);
    memcpy(RAW(res), hash, len);
    return res;
}

/**
 * \brief Erases a block of a SkipBlock NandFlash.
 *
 * \param skipBlock  Pointer to a SkipBlockNandFlash instance.
 * \param block  Number of block to erase.
 * \return the RawNandFlash_EraseBlock code or NandCommon_ERROR_WRONGSTATUS.
 */
uint8_t SkipBlockNandFlash_EraseBlock(
    struct SkipBlockNandFlash *skipBlock,
    uint16_t block,
    uint32_t eraseType)
{
    uint8_t error;
    const struct NandSpareScheme *scheme;
    uint8_t spare[NandCommon_MAXPAGESPARESIZE];

    // TRACE_INFO("SkipBlockNandFlash_EraseBlock(%d)\n\r", block);

    if (eraseType != SCRUB_ERASE) {
        /* Check block status */
        if (SkipBlockNandFlash_CheckBlock(skipBlock, block) != GOODBLOCK) {

            TRACE_INFO("SkipBlockNandFlash_EraseBlock: Block is BAD\n\r");
            return NandCommon_ERROR_BADBLOCK;
        }
    }

    /* Erase block */
    error = RawNandFlash_EraseBlock(RAW(skipBlock), block);
    if (error) {

        /* Try to mark the block as BAD */
        TRACE_ERROR("SkipBlockNandFlash_EraseBlock: Cannot erase block, try to mark it BAD\n\r");

        /* Retrieve model scheme */
        scheme = NandFlashModel_GetScheme(MODEL(skipBlock));

        memset(spare, 0xFF, NandCommon_MAXPAGESPARESIZE);
        NandSpareScheme_WriteBadBlockMarker(scheme, spare, NandBlockStatus_BAD_skip);
        return RawNandFlash_WritePage(RAW(skipBlock), block, 0, 0, spare);
    }

    return 0;
}

SEXP PKI_decrypt(SEXP what, SEXP sKey) {
    SEXP res;
    EVP_PKEY *key;
    RSA *rsa;
    int len;
    if (TYPEOF(what) != RAWSXP)
	Rf_error("invalid payload to sign - must be a raw vector");
    if (!inherits(sKey, "private.key"))
	Rf_error("invalid key object");
    key = (EVP_PKEY*) R_ExternalPtrAddr(sKey);
    if (!key)
	Rf_error("NULL key");
    if (EVP_PKEY_type(key->type) != EVP_PKEY_RSA)
	Rf_error("Sorry only RSA keys are supported at this point");
    rsa = EVP_PKEY_get1_RSA(key);
    if (!rsa)
	Rf_error("%s", ERR_error_string(ERR_get_error(), NULL));
    len = RSA_private_decrypt(LENGTH(what), RAW(what), (unsigned char*) buf, rsa, RSA_PKCS1_PADDING);
    if (len < 0)
	Rf_error("%s", ERR_error_string(ERR_get_error(), NULL));
    res = allocVector(RAWSXP, len);
    memcpy(RAW(res), buf, len);
    return res;
}

/* BN_bn2bin() drops leading zeros which can alter openssh fingerprint */
SEXP bignum_to_r_size(const BIGNUM *bn, int bytes){
  int bits = BN_num_bits(bn);
  if(bytes == 0)
    bytes = (bits/8) + 1;
  int numbytes = BN_num_bytes(bn);
  int diff = bytes - numbytes;
  SEXP res = PROTECT(allocVector(RAWSXP, bytes));
  setAttrib(res, R_ClassSymbol, mkString("bignum"));
  UNPROTECT(1);
  unsigned char *ptr = RAW(res);
  memset(ptr, 0, diff);
  ptr += diff;
  BN_bn2bin(bn, ptr);
  return res;
}

/* {{{ rberkeley_db_compact */
SEXP rberkeley_db_compact (SEXP _dbp, SEXP _txnid, SEXP _start,
                           SEXP _stop, SEXP _c_data, SEXP _flags)
{
  DB *dbp;
  DB_TXN *txnid;
  DBT start, stop, end;
  /*DB_COMPACT c_data;*/
  u_int32_t flags;
  int ret;

  if(isNull(_txnid)) {
    txnid = R_ExternalPtrAddr(_txnid);
  } else {
    txnid = NULL;
  }
  if(!isNull(_start)) {
    memset(&start, 0, sizeof(DBT));
    start.data = (unsigned char *)RAW(_start);
    start.size = length(_start);
  }
  if(!isNull(_stop)) {
    memset(&stop, 0, sizeof(DBT));
    stop.data = (unsigned char *)RAW(_stop);
    stop.size = length(_stop);
  }
  flags = (u_int32_t)INTEGER(_flags)[0];
  /*memset(&end, 0, sizeof(end));*/

  dbp = R_ExternalPtrAddr(_dbp);
  if(R_ExternalPtrTag(_dbp) != RBerkeley_DB || dbp == NULL)
    error("invalid 'db' handle");

  ret = dbp->compact(dbp, txnid, &start, &stop, NULL, flags, &end); 

  return ScalarInteger(ret);
}

SEXP graph_bitarray_transpose(SEXP bits)
{
    SEXP ans;
    int nrow, i, j, len = length(bits);
    unsigned char *bytes = RAW(bits), *ans_bytes;
    ans = PROTECT(duplicate(bits)); /* dup to capture attributes */
    ans_bytes = RAW(ans);
    memset(ans_bytes, 0, len);
    nrow = NROW(bits);
    /* FIXME: use a single loop, look at R's array.c */
    for (i = 0; i < nrow; i++) {
        for (j = 0; j < nrow; j++) {
            int idx = COORD_TO_INDEX(i, j, nrow),
                tidx = COORD_TO_INDEX(j, i, nrow);
            int byteIndex = idx / 8,
                bitIndex = idx % 8,
                tBitIndex = tidx % 8;
            if (IS_SET(bytes, byteIndex, bitIndex))
                ans_bytes[tidx / 8] |= (1 << tBitIndex);
        }
    }
    UNPROTECT(1);
    return ans;
}

/* flexible and fast for long strings. Since short string are, well,
   short, the overhead of building a table should play no role */
SEXP C_URIencode(SEXP what, SEXP resrv) {
    SEXP res;
    char tab[256];
    const unsigned char *c = (const unsigned char*) plain;
    if (TYPEOF(what) != STRSXP && TYPEOF(what) != RAWSXP)
	Rf_error("input must be a raw or character vector");
    memset(tab, 0, sizeof(tab));
    while (*c) tab[*(c++)] = 1;
    if (TYPEOF(resrv) == STRSXP) {
	int n = LENGTH(resrv), i;
	for (i = 0; i < n; i++) {
	    c = (const unsigned char*) CHAR(STRING_ELT(resrv, i));
	    while (*c) tab[*(c++)] = 1;
	}
    }
    if (TYPEOF(what) == RAWSXP) {
	int len = 0;
	const unsigned char *cend =
	    (c = (const unsigned char*) RAW(what)) +
	    LENGTH(what);
	char *enc, *ce;
	while (c < cend)
	    len += tab[*(c++)] ? 1 : 3;
	ce = enc = (char*) R_alloc(1, len + 1);
	c = (const unsigned char*) RAW(what);
	while (c < cend)
	    if (tab[*c])
		*(ce++) = *(c++);
	    else {
		*(ce++) = '%';
		*(ce++) = hex[*c >> 4];
		*(ce++) = hex[*(c++) & 0x0F];
	    }
	*ce = 0;
	return mkString(enc);
    } else {

SEXP R_rsa_key_build(SEXP e, SEXP n, SEXP p, SEXP q, SEXP d, SEXP dp, SEXP dq, SEXP qi){
  RSA *rsa = RSA_new();
  MY_RSA_set0_key(rsa, new_bignum_from_r(n), new_bignum_from_r(e), new_bignum_from_r(d));
  MY_RSA_set0_factors(rsa, new_bignum_from_r(p), new_bignum_from_r(q));
  MY_RSA_set0_crt_params(rsa, new_bignum_from_r(dp), new_bignum_from_r(dq), new_bignum_from_r(qi));
  bail(RSA_check_key(rsa));
  unsigned char *buf = NULL;
  int len = i2d_RSAPrivateKey(rsa, &buf);
  bail(len);
  RSA_free(rsa);
  SEXP res = allocVector(RAWSXP, len);
  memcpy(RAW(res), buf, len);
  OPENSSL_free(buf);
  return res;
}

SEXP R_dsa_pubkey_decompose(SEXP bin){
  DSA *dsa = DSA_new();
  const unsigned char *ptr = RAW(bin);
  bail(!!d2i_DSA_PUBKEY(&dsa, &ptr, LENGTH(bin)));
  const BIGNUM *p, *q, *g, *pub_key;
  MY_DSA_get0_pqg(dsa, &p, &q, &g);
  MY_DSA_get0_key(dsa, &pub_key, NULL);
  SEXP res = PROTECT(allocVector(VECSXP, 4));
  SET_VECTOR_ELT(res, 0, bignum_to_r(p));
  SET_VECTOR_ELT(res, 1, bignum_to_r(q));
  SET_VECTOR_ELT(res, 2, bignum_to_r(g));
  SET_VECTOR_ELT(res, 3, bignum_to_r(pub_key));
  UNPROTECT(1);
  return res;
}

SEXP parse_headers(SEXP sRaw) {
    SEXP res = PROTECT(allocVector(STRSXP, MAX_HDR_ENTRIES)), rn = allocVector(STRSXP, MAX_HDR_ENTRIES);
    Rf_setAttrib(res, R_NamesSymbol, rn);
    int i = 0;
    const char *cs = (const char*) RAW(sRaw), *c = cs, *e;
    R_xlen_t len = XLENGTH(sRaw), ct = 0;
    e = c + len;
    while (c < e) {
        const char *r = memchr(c, ':', e - c);
        if (!r) /* we jsut ignore trailing content - it shouldn't be there ... */
            break;

        if (i == MAX_HDR_ENTRIES)
            Rf_error("Sorry, too many header entries, aborting");

        /* we have header field entry - add it */
        SET_STRING_ELT(rn, i, mkCharLen(c, r - c));
        c = r + 1;
        while (c < e && (*c == ' ' || *c == '\t')) c++;
        const char *val = c;
        while (1) {
            r = memchr(c, '\n', e - c);
            /* if we don't find a newline then just use everything till the end */
            if (!r) {
                while (e > c && (e[-1] == '\r' || e[-1] == '\n')) e--;
                SET_STRING_ELT(res, i, mkCharLen(val, e - val));
                i++;
                c = e; /* end */
                break;
            }
            /* advance */
            c = r + 1;
            /* not a continuation? add it */
            if (!(c < e && (*c == ' ' || *c == '\t'))) {
                /* trim newlines */
                while (r > val && (*r == '\n' || *r == '\t')) r--;
                SET_STRING_ELT(res, i, mkCharLen(val, r - val));
                i++;
                break;
            }
            /* continuation */
        }
    }
    SETLENGTH(rn, i);
    SETLENGTH(res, i);
    UNPROTECT(1);
    return res;
}

/*
 * Convert a raw binary unpacked SciDB array to a list.
 * M: Number of rows  (int) to try to unpack
 * TYPES: Character vector of SciDB types, of length N
 * NULLABLE: Logical vector of SciDB nullability, of length N
 * DATA: R RAW vector with the binary SciDB data
 * OFFSET: Offset byte to start reading from (REAL)
 *
 * Output: An n+2-element list:
 * Elements 1,2,...,n are the parsed data vectors
 * Element n is the number of rows retrieved <= M
 * Element n+1 is the final byte offset into DATA
 */
SEXP scidb_parse (SEXP M, SEXP TYPES, SEXP NULLABLE, SEXP DATA, SEXP OFFSET)
{
  int nullable, i=0,j;
  SEXP col, val, ans;
  int m = INTEGER(M)[0];
  R_xlen_t n = XLENGTH(TYPES);
  double doffset = REAL(OFFSET)[0];
  size_t offset = (size_t)doffset;
  R_xlen_t s = XLENGTH(DATA);
  char *p = (char *)RAW(DATA);
  char *q = p;
  p+=offset;

// Check length mismatch
  if(n!=XLENGTH(NULLABLE)) error("length(TYPES) must match length(NULLABLE)");
// create the data frame list
  ans = PROTECT (NEW_LIST (n+2));
  int protectCount = 1;

// fill in the list with columns of an appropriate type and size
  for (j = 0; j < n; ++j)
  {
    SET_VECTOR_ELT(ans,j, PROTECT(scidb_type_vector(CHAR(STRING_ELT(TYPES,j)), m)));
    protectCount++;
  }
// Make sure starting condition is valid
  if(p-q >= s) goto end;
  for(i=0;i<m;++i)
  {
    for(j=0;j<n;++j)
    {
      col = VECTOR_ELT(ans,j);
// XXX Add max bytes allowed to read here...
      scidb_value(&p, CHAR(STRING_ELT(TYPES,j)), INTEGER(NULLABLE)[j], col, i);
      if(p-q >= s)
      {
        i++;
        goto end;
      }
    }
  }

end:
  SET_VECTOR_ELT(ans, n, ScalarInteger(i));
  SET_VECTOR_ELT(ans, n+1, ScalarReal((double)(p-q)));
  UNPROTECT (protectCount);
  return (ans);
}

extern "C" SEXP unserializeFromRaw(SEXP object) {

    struct R_inpstream_st in;

    /* We might want to read from a long raw vector */
    struct membuf_st mbs;

    if (TYPEOF(object) == RAWSXP) {
        void *data = RAW(object);
        R_xlen_t length = XLENGTH(object);
        InitMemInPStream(&in, &mbs, data,  length, NULL, NULL);
        return R_Unserialize(&in);
    }
    error("can't unserialize object");
    return(R_UnboundValue);
}

SEXP ConvertBinary(bson_iter_t* iter){
  bson_subtype_t subtype;
  uint32_t binary_len;
  const uint8_t *binary;
  bson_iter_binary(iter, &subtype, &binary_len, &binary);

  //create raw vector
  SEXP out = PROTECT(allocVector(RAWSXP, binary_len));
  for (int i = 0; i < binary_len; i++) {
    RAW(out)[i] = binary[i];
  }
  setAttrib(out, install("subtype"), ScalarInteger(subtype));
  UNPROTECT(1);
  return out;

}

SEXP
R_unzReadCurrentFile(SEXP r_unzFile, SEXP r_buf, SEXP r_numBytes)
{
  unzFile f =  DEREF_REF_PTR_CLASS( r_unzFile,  unzFile, unzContent );
  int err = UNZ_OK;
  void *buf;
  int numBytes;

  numBytes = REAL(r_numBytes)[0];

  buf = TYPEOF(r_buf) == RAWSXP ? RAW(r_buf) : (void*) CHAR(STRING_ELT(r_buf, 0));

  err = unzReadCurrentFile(f, buf, numBytes);

  return(ScalarLogical(err > 0));
}

/* convert single precision object to a numeric vector */
SEXP float2double(SEXP fObject) {
    const float *f;
    double *d;
    SEXP res;
    int i, n;
    
    if (TYPEOF(fObject) != RAWSXP || !inherits(fObject, "clFloat"))
	Rf_error("invalid single precision object");
    n = LENGTH(fObject) / sizeof(float);
    res = Rf_allocVector(REALSXP, n);
    d = REAL(res);
    f = (const float*) RAW(fObject);
    for (i = 0; i < n; i++)
	d[i] = f[i];
    return res;
}