int find_offset(SEXP x, SEXP index, int i) {
if (!Rf_isVector(index) || Rf_length(index) != 1)
Rf_errorcall(R_NilValue, "Index %i is not a length 1 vector", i + 1);
int n = Rf_length(x);
if (TYPEOF(index) == INTSXP) {
int val = INTEGER(index)[0];
if (val == NA_INTEGER)
return -1;
val--;
if (val < 0 || val >= n)
return -1;
return val;
} if (TYPEOF(index) == REALSXP) {
double val = REAL(index)[0];
if (!R_finite(val))
return -1;
val--;
if (val < 0 || val >= n)
return -1;
return val;
} else if (TYPEOF(index) == STRSXP) {
SEXP names = Rf_getAttrib(x, R_NamesSymbol);
if (names == R_NilValue) // vector doesn't have names
return -1;
if (STRING_ELT(index, 0) == NA_STRING)
return -1;
const char* val = Rf_translateCharUTF8(STRING_ELT(index, 0));
if (val[0] == '\0') // "" matches nothing
return -1;
for (int j = 0; j < Rf_length(names); ++j) {
if (STRING_ELT(names, j) == NA_STRING)
continue;
const char* names_j = Rf_translateCharUTF8(STRING_ELT(names, j));
if (strcmp(names_j, val) == 0)
return j;
}
return -1;
} else {
Rf_errorcall(R_NilValue,
"Don't know how to index with object of type %s at level %i",
Rf_type2char(TYPEOF(index)), i + 1
);
}
}
SEXP R_mongo_collection_rename(SEXP ptr_col, SEXP db, SEXP name) {
mongoc_collection_t *col = r2col(ptr_col);
bson_error_t err;
const char *new_db = NULL;
if(db != R_NilValue)
new_db = Rf_translateCharUTF8(Rf_asChar(db));
if(!mongoc_collection_rename(col, new_db, Rf_translateCharUTF8(Rf_asChar(name)), false, &err))
stop(err.message);
return Rf_ScalarLogical(1);
}
SEXP R_mongo_collection_drop_index(SEXP ptr_col, SEXP name) {
mongoc_collection_t *col = r2col(ptr_col);
const char *str = Rf_translateCharUTF8(Rf_asChar(name));
bson_error_t err;
if(!mongoc_collection_drop_index(col, str, &err))
stop(err.message);
return Rf_ScalarLogical(1);
}
SEXP store_password(SEXP svc, SEXP usr, SEXP pwd) {
OSStatus status;
SecKeychainRef kc = NULL; /* default */
const char *un, *sn, *pw;
char *svc_name;
int l;
if (TYPEOF(svc) != STRSXP || LENGTH(svc) != 1) Rf_error("Invalid service name");
if (TYPEOF(pwd) != STRSXP || LENGTH(pwd) != 1) Rf_error("Invalid password");
pw = Rf_translateCharUTF8(STRING_ELT(pwd, 0));
if (usr == R_NilValue) {
un = getlogin();
if (!un) Rf_error("Unable to get current user name via getlogin()");
} else {
if (TYPEOF(usr) != STRSXP || LENGTH(usr) != 1)
Rf_error("Invalid user name (must be a character vector of length one)");
un = Rf_translateCharUTF8(STRING_ELT(usr, 0));
}
sn = Rf_translateCharUTF8(STRING_ELT(svc, 0));
l = strlen(sn);
if (l > sizeof(buf) - 16) {
svc_name = (char*) malloc(l + 16);
if (!svc_name) Rf_error("Cannot allocate memory for service name");
} else svc_name = buf;
/* we are enforcing R.keychain. prefix to avoid abuse to access other system keys */
strcpy(svc_name, SEC_PREFIX);
strcat(svc_name, sn);
status = SecKeychainAddGenericPassword(kc,
strlen(svc_name), svc_name,
strlen(un), un,
strlen(pw), pw,
NULL);
if (svc_name != buf) free(svc_name);
chk_status(status, "add");
return R_NilValue;
}
CharacterVector reencode_char(SEXP x) {
if (Rf_isFactor(x)) return reencode_factor(x);
CharacterVector xc(x);
R_xlen_t first = get_first_reencode_pos(xc);
if (first >= xc.length()) return x;
CharacterVector ret(Rf_duplicate(xc));
R_xlen_t len = ret.length();
for (R_xlen_t i = first; i < len; ++i) {
SEXP reti = ret[i];
if (reti != NA_STRING && !IS_ASCII(reti) && !IS_UTF8(reti)) {
ret[i] = String(Rf_translateCharUTF8(reti), CE_UTF8);
}
}
return ret;
}
bool cols_wrap<std::string>::get(size_t i, VARIANT &v) const
{
if (i >= len)
{
v.vt = VT_NULL;
return true;
}
SEXP s = STRING_ELT(vect, i);
if (s == NA_STRING)
v.vt = VT_NULL;
else
{ v.vt = VT_BSTR;
const char* ptr = Rf_translateCharUTF8(s);
_bstr_t str(ptr);
v.bstrVal = str.Detach();
}
return true;
}
SEXP R_mongo_collection_insert_page(SEXP ptr_col, SEXP json_vec, SEXP stop_on_error){
if(!Rf_isString(json_vec) || !Rf_length(json_vec))
stop("json_vec must be character string of at least length 1");
//ordered means serial execution
bool ordered = Rf_asLogical(stop_on_error);
//create bulk operation
bson_error_t err;
bson_t *b;
bson_t reply;
mongoc_bulk_operation_t *bulk = mongoc_collection_create_bulk_operation_with_opts (r2col(ptr_col), NULL);
for(int i = 0; i < Rf_length(json_vec); i++){
b = bson_new_from_json ((uint8_t*) Rf_translateCharUTF8(Rf_asChar(STRING_ELT(json_vec, i))), -1, &err);
if(!b){
mongoc_bulk_operation_destroy (bulk);
stop(err.message);
}
mongoc_bulk_operation_insert(bulk, b);
bson_destroy (b);
b = NULL;
}
//execute bulk operation
bool success = mongoc_bulk_operation_execute (bulk, &reply, &err);
mongoc_bulk_operation_destroy (bulk);
//check for errors
if(!success){
if(ordered){
Rf_errorcall(R_NilValue, err.message);
} else {
Rf_warningcall(R_NilValue, "Not all inserts were successful: %s\n", err.message);
}
}
//get output
SEXP out = PROTECT(bson2list(&reply));
bson_destroy (&reply);
UNPROTECT(1);
return out;
}
SEXP find_password(SEXP svc, SEXP usr, SEXP new_pwd, SEXP quiet, SEXP del) {
SEXP res;
OSStatus status;
SecKeychainRef kc = NULL; /* default */
SecKeychainItemRef kci;
const char *un, *sn;
char *svc_name;
void *pwd;
UInt32 pwd_len = 0;
int l;
int silent = Rf_asInteger(quiet) == 1;
int do_rm = Rf_asInteger(del) == 1;
int modify = 0;
if (TYPEOF(svc) != STRSXP || LENGTH(svc) != 1) Rf_error("Invalid service name");
if (new_pwd != R_NilValue && (TYPEOF(new_pwd) != STRSXP || LENGTH(new_pwd) != 1))
Rf_error("Invalid password");
if (new_pwd != R_NilValue || do_rm) modify = 1;
if (usr == R_NilValue) {
un = getlogin();
if (!un) Rf_error("Unable to get current user name via getlogin()");
} else {
if (TYPEOF(usr) != STRSXP || LENGTH(usr) != 1)
Rf_error("Invalid user name (must be a character vector of length one)");
un = Rf_translateCharUTF8(STRING_ELT(usr, 0));
}
sn = Rf_translateCharUTF8(STRING_ELT(svc, 0));
l = strlen(sn);
if (l > sizeof(buf) - 16) {
svc_name = (char*) malloc(l + 16);
if (!svc_name) Rf_error("Cannot allocate memory for service name");
} else svc_name = buf;
/* we are enforcing R.keychain. prefix to avoid abuse to access other system keys */
strcpy(svc_name, SEC_PREFIX);
strcat(svc_name, sn);
status = SecKeychainFindGenericPassword(kc,
strlen(svc_name), svc_name,
strlen(un), un,
&pwd_len, &pwd,
modify ? &kci : NULL);
if (svc_name != buf) free(svc_name);
if (silent && status == errSecItemNotFound) return R_NilValue;
chk_status(status, "find");
res = PROTECT(Rf_ScalarString(Rf_mkCharLenCE(pwd, pwd_len, CE_UTF8)));
/* FIXME: we'll leak if the above fails in R */
SecKeychainItemFreeContent(NULL, pwd);
if (do_rm) {
status = SecKeychainItemDelete(kci);
chk_status(status, "delete");
} else if (new_pwd != R_NilValue) { /* set a new one */
const char *np = Rf_translateCharUTF8(STRING_ELT(new_pwd, 0));
status = SecKeychainItemModifyContent(kci, NULL, strlen(np), np);
chk_status(status, "modify");
}
UNPROTECT(1);
return res;
}
SEXP R_mongo_collection_new(SEXP ptr_client, SEXP collection, SEXP db) {
mongoc_client_t *client = r2client(ptr_client);
mongoc_collection_t *col = mongoc_client_get_collection (client,
Rf_translateCharUTF8(Rf_asChar(db)), Rf_translateCharUTF8(Rf_asChar(collection)));
return col2r(col, ptr_client);
}
