curl

int R_curl_callback_debug(CURL *handle, curl_infotype type_, char *data,
                          size_t size, SEXP fun) {

  /* wrap type and msg into R types */
  SEXP type = PROTECT(Rf_ScalarInteger(type_));
  SEXP msg = PROTECT(Rf_allocVector(RAWSXP, size));
  if (size) memcpy(RAW(msg), data, size);

  /* call the R function */
  SEXP call = PROTECT(Rf_lang3(fun, type, msg));
  R_tryEval(call, R_GlobalEnv, NULL);

  UNPROTECT(3);
  // Debug function must always return 0
  return 0;
}

int R_curl_callback_progress(SEXP fun,
                             double dltotal, double dlnow,
                             double ultotal, double ulnow) {

  SEXP down = PROTECT(Rf_allocVector(REALSXP, 2));
  REAL(down)[0] = dltotal;
  REAL(down)[1] = dlnow;

  SEXP up = PROTECT(Rf_allocVector(REALSXP, 2));
  REAL(up)[0] = ultotal;
  REAL(up)[1] = ulnow;

  SEXP call = PROTECT(Rf_lang3(fun, down, up));
  int ok;
  SEXP res = PROTECT(R_tryEval(call, R_GlobalEnv, &ok));

  if (ok != 0) {
    UNPROTECT(4);
    return CURL_READFUNC_ABORT;
  }

  if (TYPEOF(res) != LGLSXP || Rf_length(res) != 1) {
    UNPROTECT(4);
    Rf_warning("progress callback must return boolean");
    return 0;
  }

  int out = Rf_asLogical(res);
  UNPROTECT(4);
  return !out;
}

size_t R_curl_callback_read(char *buffer, size_t size, size_t nitems, SEXP fun) {
  SEXP nbytes = PROTECT(Rf_ScalarInteger(size * nitems));
  SEXP call = PROTECT(Rf_lang2(fun, nbytes));

  int ok;
  SEXP res = PROTECT(R_tryEval(call, R_GlobalEnv, &ok));

  if (ok != 0) {
    UNPROTECT(3);
    return CURL_READFUNC_ABORT;
  }

  if (TYPEOF(res) != RAWSXP) {
    UNPROTECT(3);
    Rf_warning("read callback must raw vector");
    return CURL_READFUNC_ABORT;
  }

  size_t bytes_read = Rf_length(res);
  if (bytes_read) memcpy(buffer, RAW_RO(res), bytes_read);

  UNPROTECT(3);
  return bytes_read;
}

int R_curl_callback_seek(SEXP fun, curl_off_t offset, int origin){
  SEXP soffset = PROTECT(Rf_ScalarReal(offset));
  SEXP call = PROTECT(Rf_lang2(fun, soffset));
  int ok;
  R_tryEval(call, R_GlobalEnv, &ok);
  UNPROTECT(2);
  return ok ? CURL_SEEKFUNC_FAIL : CURL_SEEKFUNC_OK;
}

int R_curl_callback_ssl_ctx(CURL *handle, void *ssl_ctx, SEXP fun){
  SEXP ptr = PROTECT(R_MakeExternalPtr(ssl_ctx, R_NilValue, R_NilValue));
  Rf_setAttrib(ptr, R_ClassSymbol, Rf_mkString("ssl_ctx"));
  SEXP call = PROTECT(Rf_lang2(fun, ptr));
  int err = 0;
  R_tryEval(call, R_GlobalEnv, &err);
  UNPROTECT(2);
  return err;
}

int R_curl_callback_xferinfo(SEXP fun,
                             curl_off_t  dltotal, curl_off_t  dlnow,
                             curl_off_t  ultotal, curl_off_t  ulnow) {
  return R_curl_callback_progress(fun, dltotal, dlnow, ultotal, ulnow);
}

SEXP R_curl_connection(SEXP url, SEXP ptr, SEXP partial) {
  if(!Rf_isString(url))
    Rf_error("Argument 'url' must be string.");

  /* create the R connection object, mimicking base::url() */
  Rconnection con;

  /* R wants description in native encoding, but we use UTF-8 URL below */
  SEXP rc = PROTECT(R_new_custom_connection(Rf_translateChar(STRING_ELT(url, 0)), "r", "curl", &con));

  /* setup curl. These are the parts that are recycable. */
  request *req = malloc(sizeof(request));
  req->handle = get_handle(ptr);
  req->ref = get_ref(ptr);
  req->limit = CURL_MAX_WRITE_SIZE;
  req->buf = malloc(req->limit);
  req->manager = curl_multi_init();
  req->partial = Rf_asLogical(partial); //only for curl_fetch_stream()
  req->used = 0;

  /* allocate url string */
  req->url = malloc(strlen(Rf_translateCharUTF8(Rf_asChar(url))) + 1);
  strcpy(req->url, Rf_translateCharUTF8(Rf_asChar(url)));

  /* set connection properties */
  con->incomplete = FALSE;
  con->private = req;
  con->canseek = FALSE;
  con->canwrite = FALSE;
  con->isopen = FALSE;
  con->blocking = TRUE;
  con->text = TRUE;
  con->UTF8out = TRUE;
  con->open = rcurl_open;
  con->close = reset;
  con->destroy = cleanup;
  con->read = rcurl_read;
  con->fgetc = rcurl_fgetc;
  con->fgetc_internal = rcurl_fgetc;

  /* protect the handle */
  (req->ref->refCount)++;

  /* store the CURLM address in con->ex_ptr which is the 'conn_id' attribute */
  R_SetExternalPtrAddr((SEXP) con->ex_ptr, req->manager);

  UNPROTECT(1);
  return rc;
}

SEXP R_curl_dryrun(SEXP ptr){
  CURL *handle = get_handle(ptr);
  curl_easy_setopt(handle, CURLOPT_WRITEFUNCTION, write_nothing);
  CURLM * multi_handle = curl_multi_init();
  if(CURLM_OK != curl_multi_add_handle(multi_handle, handle))
    Rf_error("Failed to add handle");
  int still_running = 1;
  while(still_running) {
    if(process_server())
      break;
    if(curl_multi_perform(multi_handle, &(still_running)) != CURLM_OK)
      break;
  }
  int msgq = 0;
  CURLMsg *m = curl_multi_info_read(multi_handle, &msgq);
  CURLcode status = (m && (m->msg == CURLMSG_DONE)) ? m->data.result : CURLE_ABORTED_BY_CALLBACK;
  curl_easy_setopt(handle, CURLOPT_WRITEFUNCTION, NULL);
  curl_multi_remove_handle(multi_handle, handle);
  curl_multi_cleanup(multi_handle);
  assert_status(status, get_ref(ptr));
  return R_NilValue;
}

SEXP R_curl_fetch_disk(SEXP url, SEXP ptr, SEXP path, SEXP mode, SEXP nonblocking){
  if (!Rf_isString(url) || Rf_length(url) != 1)
    Rf_error("Argument 'url' must be string.");
  if (!Rf_isString(path) || Rf_length(path) != 1)
    Rf_error("`path` must be string.");

  /* get the handle */
  CURL *handle = get_handle(ptr);

  /* update the url */
  curl_easy_setopt(handle, CURLOPT_URL, CHAR(STRING_ELT(url, 0)));

  /* reset the response header buffer */
  reset_resheaders(get_ref(ptr));
  reset_errbuf(get_ref(ptr));

  /* open file */
  FILE *dest = fopen(CHAR(Rf_asChar(path)), CHAR(Rf_asChar(mode)));
  if(!dest)
    Rf_error("Failed to open file %s.", CHAR(Rf_asChar(path)));
  curl_easy_setopt(handle, CURLOPT_WRITEFUNCTION, push_disk);
  curl_easy_setopt(handle, CURLOPT_WRITEDATA, dest);

  /* perform blocking request */
  CURLcode status = Rf_asLogical(nonblocking) ?
    curl_perform_with_interrupt(handle): curl_easy_perform(handle);

  /* cleanup */
  curl_easy_setopt(handle, CURLOPT_WRITEFUNCTION, NULL);
  curl_easy_setopt(handle, CURLOPT_WRITEDATA, NULL);
  fclose(dest);

  /* check for errors */
  assert_status(status, get_ref(ptr));

  /* return the file path */
  return path;
}

SEXP R_curl_fetch_memory(SEXP url, SEXP ptr, SEXP nonblocking){
  if (!Rf_isString(url) || Rf_length(url) != 1)
    Rf_error("Argument 'url' must be string.");

  /* get the handle */
  CURL *handle = get_handle(ptr);

  /* update the url */
  curl_easy_setopt(handle, CURLOPT_URL, CHAR(STRING_ELT(url, 0)));

  /* reset the response header buffer */
  reset_resheaders(get_ref(ptr));
  reset_errbuf(get_ref(ptr));

  /* buffer body */
  memory body = {NULL, 0};
  curl_easy_setopt(handle, CURLOPT_WRITEFUNCTION, append_buffer);
  curl_easy_setopt(handle, CURLOPT_WRITEDATA, &body);

  /* perform blocking request */
  CURLcode status = Rf_asLogical(nonblocking) ?
    curl_perform_with_interrupt(handle) : curl_easy_perform(handle);

  /* Reset for reuse */
  curl_easy_setopt(handle, CURLOPT_WRITEFUNCTION, NULL);
  curl_easy_setopt(handle, CURLOPT_WRITEDATA, NULL);

  /* check for errors */
  if (status != CURLE_OK) {
    free(body.buf);
    assert_status(status, get_ref(ptr));
  }

  /* create output */
  SEXP out = PROTECT(Rf_allocVector(RAWSXP, body.size));

  /* copy only if there is actual content */
  if(body.size)
    memcpy(RAW(out), body.buf, body.size);

  /* cleanup and return */
  UNPROTECT(1);
  free(body.buf);
  return out;
}

SEXP R_download_curl(SEXP url, SEXP destfile, SEXP quiet, SEXP mode, SEXP ptr, SEXP nonblocking) {
  if(!Rf_isString(url))
    Rf_error("Argument 'url' must be string.");

  if(!Rf_isString(destfile))
    Rf_error("Argument 'destfile' must be string.");

  if(!Rf_isLogical(quiet))
    Rf_error("Argument 'quiet' must be TRUE/FALSE.");

  if(!Rf_isString(mode))
    Rf_error("Argument 'mode' must be string.");

  /* get the handle */
  CURL *handle = get_handle(ptr);
  reset_errbuf(get_ref(ptr));

  /* open file */
  FILE *dest = fopen(CHAR(Rf_asChar(destfile)), CHAR(Rf_asChar(mode)));
  if(!dest)
    Rf_error("Failed to open file %s.", CHAR(Rf_asChar(destfile)));

  /* set options */
  curl_easy_setopt(handle, CURLOPT_URL, Rf_translateCharUTF8(Rf_asChar(url)));
  curl_easy_setopt(handle, CURLOPT_NOPROGRESS, (long) Rf_asLogical(quiet));
  curl_easy_setopt(handle, CURLOPT_WRITEFUNCTION, push_disk);
  curl_easy_setopt(handle, CURLOPT_WRITEDATA, dest);
  curl_easy_setopt(handle, CURLOPT_FAILONERROR, 1L);

  /* perform blocking request */
  CURLcode status = Rf_asLogical(nonblocking) ?
    curl_perform_with_interrupt(handle) : curl_easy_perform(handle);

  /* cleanup */
  curl_easy_setopt(handle, CURLOPT_NOPROGRESS, 1L);
  curl_easy_setopt(handle, CURLOPT_WRITEFUNCTION, NULL);
  curl_easy_setopt(handle, CURLOPT_WRITEDATA, NULL);
  curl_easy_setopt(handle, CURLOPT_FAILONERROR, 0L);
  fclose(dest);

  /* raise for curl errors */
  assert_status(status, get_ref(ptr));
  return Rf_ScalarInteger(0);
}

SEXP R_findport(SEXP candidates){
  for(int i = 0; i < Rf_length(candidates); i++){
    int port = INTEGER(candidates)[i];
    if(port_is_available(port)){
      return Rf_ScalarInteger(port);
    }
  }
  return R_NilValue;
}

SEXP R_get_handle_clength(SEXP ptr){
  CURL *handle = get_handle(ptr);
  curl_off_t cl = 0;
  curl_easy_getinfo(handle, CURLINFO_CONTENT_LENGTH_DOWNLOAD_T, &cl);
  return Rf_ScalarReal((double) cl < 0 ? NA_REAL : cl);
}

SEXP R_get_handle_cookies(SEXP ptr){
  return make_cookievec(get_handle(ptr));
}

SEXP R_get_handle_mtime(SEXP ptr){
  return make_filetime(get_handle(ptr));
}

SEXP R_get_handle_received(SEXP ptr){
  CURL *handle = get_handle(ptr);
  curl_off_t dl = 0;
  curl_easy_getinfo(handle, CURLINFO_SIZE_DOWNLOAD_T, &dl);
  return Rf_ScalarReal((double) dl);
}

SEXP R_get_handle_response(SEXP ptr){
  /* get the handle */
  reference *ref = get_ref(ptr);
  return make_handle_response(ref);
}

SEXP R_get_handle_speed(SEXP ptr){
  CURL *handle = get_handle(ptr);
  curl_off_t dl = 0;
  curl_off_t ul = 0;
  curl_easy_getinfo(handle, CURLINFO_SPEED_DOWNLOAD_T, &dl);
  curl_easy_getinfo(handle, CURLINFO_SPEED_UPLOAD_T, &ul);
  SEXP out = Rf_allocVector(REALSXP, 2);
  REAL(out)[0] = (double) dl;
  REAL(out)[1] = (double) ul;
  return out;
}

SEXP R_get_proxy_for_url(SEXP target_url, SEXP auto_detect, SEXP autoproxy_url){
  return R_NilValue;
}

SEXP R_handle_getcustom(SEXP ptr){
  reference *ref = get_ref(ptr);
  return slist_to_vec(ref->custom);
}

SEXP R_handle_getheaders(SEXP ptr){
  reference *ref = get_ref(ptr);
  return slist_to_vec(ref->headers);
}

SEXP R_handle_reset(SEXP ptr){
  //reset all fields
  reference *ref = get_ref(ptr);
  set_form(ref, NULL);
  reset_errbuf(ref);
  curl_easy_reset(ref->handle);

  //clear custom vector field
  if(ref->custom){
    curl_slist_free_all(ref->custom);
    ref->custom = NULL;
  }

  //restore default settings
  set_handle_defaults(ref);
  return Rf_ScalarLogical(1);
}

SEXP R_handle_setform(SEXP ptr, SEXP form){
  if(!Rf_isVector(form))
    Rf_error("Form must be a list.");
  set_form(get_ref(ptr), make_form(form));
  return Rf_ScalarLogical(1);
}

SEXP R_handle_setopt(SEXP ptr, SEXP keys, SEXP values){
  reference *ref = get_ref(ptr);
  CURL *handle = get_handle(ptr);
  SEXP prot = R_ExternalPtrProtected(ptr);
  SEXP optnames = PROTECT(Rf_getAttrib(values, R_NamesSymbol));

  if(!Rf_isInteger(keys))
    Rf_error("keys` must be an integer");

  if(!Rf_isVector(values))
    Rf_error("`values` must be a list");

  for(int i = 0; i < Rf_length(keys); i++){
    int key = INTEGER(keys)[i];
    const char* optname = CHAR(STRING_ELT(optnames, i));
    SEXP val = VECTOR_ELT(values, i);
    if(val == R_NilValue){
      set_user_option(key, NULL);
    } else if (key == CURLOPT_XFERINFOFUNCTION) {
      if (TYPEOF(val) != CLOSXP)
        Rf_error("Value for option %s (%d) must be a function.", optname, key);

      set_user_option(CURLOPT_XFERINFOFUNCTION, (curl_xferinfo_callback) R_curl_callback_xferinfo);
      set_user_option(CURLOPT_XFERINFODATA, val);
      set_user_option(CURLOPT_NOPROGRESS, 0L);
      SET_VECTOR_ELT(prot, 1, val); //protect gc
    } else if (key == CURLOPT_PROGRESSFUNCTION) {
      if (TYPEOF(val) != CLOSXP)
        Rf_error("Value for option %s (%d) must be a function.", optname, key);

      set_user_option(CURLOPT_PROGRESSFUNCTION,(curl_progress_callback) R_curl_callback_progress);
      set_user_option(CURLOPT_PROGRESSDATA, val);
      set_user_option(CURLOPT_NOPROGRESS, 0L);
      SET_VECTOR_ELT(prot, 2, val); //protect gc
    } else if (key == CURLOPT_READFUNCTION) {
      if (TYPEOF(val) != CLOSXP)
        Rf_error("Value for option %s (%d) must be a function.", optname, key);

      set_user_option(CURLOPT_READFUNCTION, (curl_read_callback) R_curl_callback_read);
      set_user_option(CURLOPT_READDATA, val);
      SET_VECTOR_ELT(prot, 3, val); //protect gc
    } else if (key == CURLOPT_DEBUGFUNCTION) {
      if (TYPEOF(val) != CLOSXP)
        Rf_error("Value for option %s (%d) must be a function.", optname, key);
      set_user_option(CURLOPT_DEBUGFUNCTION, (curl_debug_callback) R_curl_callback_debug);
      set_user_option(CURLOPT_DEBUGDATA, val);
      SET_VECTOR_ELT(prot, 4, val); //protect gc
    } else if (key == CURLOPT_SSL_CTX_FUNCTION){
      if (TYPEOF(val) != CLOSXP)
        Rf_error("Value for option %s (%d) must be a function.", optname, key);

      set_user_option(CURLOPT_SSL_CTX_FUNCTION, (curl_ssl_ctx_callback) R_curl_callback_ssl_ctx);
      set_user_option(CURLOPT_SSL_CTX_DATA, val);
      SET_VECTOR_ELT(prot, 5, val); //protect gc
    } else if (key == CURLOPT_SEEKFUNCTION) {
      if (TYPEOF(val) != CLOSXP)
        Rf_error("Value for option %s (%d) must be a function.", optname, key);
      set_user_option(CURLOPT_SEEKFUNCTION, (curl_seek_callback) R_curl_callback_seek);
      set_user_option(CURLOPT_SEEKDATA, val);
      SET_VECTOR_ELT(prot, 6, val); //protect gc
    } else if (key == CURLOPT_URL) {
      /* always use utf-8 for urls */
      const char * url_utf8 = Rf_translateCharUTF8(STRING_ELT(val, 0));
      set_user_option(CURLOPT_URL, url_utf8);
    } else if(key == CURLOPT_HTTPHEADER){
      if(!Rf_isString(val))
        Rf_error("Value for option %s (%d) must be a string vector", optname, key);
      set_headers(get_ref(ptr), vec_to_slist(val));
    } else if (r_curl_is_slist_option(key)) {
      if(!Rf_isString(val))
        Rf_error("Value for option %s (%d) must be a string vector", optname, key);
      ref->custom = vec_to_slist(val);
      set_user_option(key, ref->custom);
    } else if(r_curl_is_long_option(key)){
      if(!Rf_isNumeric(val) || Rf_length(val) != 1)
        Rf_error("Value for option %s (%d) must be a number.", optname, key);
      set_user_option(key, (long) Rf_asInteger(val));
    } else if(r_curl_is_off_t_option(key)){
      if(!Rf_isNumeric(val) || Rf_length(val) != 1)
        Rf_error("Value for option %s (%d) must be a number.", optname, key);
      set_user_option(key, (curl_off_t) Rf_asReal(val));
    } else if(r_curl_is_postfields_option(key) || r_curl_is_string_option(key)){
      if(r_curl_is_postfields_option(key)){
        key = CURLOPT_POSTFIELDS; //avoid bug #313
        SET_VECTOR_ELT(prot, 7, val);
      }
      switch (TYPEOF(val)) {
      case RAWSXP:
        if(key == CURLOPT_POSTFIELDS)
          set_user_option(CURLOPT_POSTFIELDSIZE_LARGE, (curl_off_t) Rf_xlength(val));
        set_user_option(key, RAW(val));
        break;
      case STRSXP:
        if (Rf_length(val) != 1)
          Rf_error("Value for option %s (%d) must be length-1 string", optname, key);
        set_user_option(key, CHAR(STRING_ELT(val, 0)));
        break;
      default:
        Rf_error("Value for option %s (%d) must be a string or raw vector.", optname, key);
      }
    } else {
      Rf_error("Option %s (%d) has unknown or unsupported type.", optname, key);
    }
  }
  UNPROTECT(1);
  return Rf_ScalarLogical(1);
}

SEXP R_multi_cancel(SEXP handle_ptr){
  reference *ref = get_ref(handle_ptr);
  if(ref->async.mref)
    multi_release(ref);
  return handle_ptr;
}

SEXP R_multi_list(SEXP pool_ptr){
  return get_multiref(pool_ptr)->handles;
}

SEXP R_new_handle(void){
  reference *ref = calloc(1, sizeof(reference));
  ref->refCount = 1;
  ref->handle = curl_easy_init();
  total_handles++;
  set_handle_defaults(ref);
  SEXP prot = PROTECT(Rf_allocVector(VECSXP, 8)); //for protecting callback functions
  SEXP ptr = PROTECT(R_MakeExternalPtr(ref, R_NilValue, prot));
  R_RegisterCFinalizerEx(ptr, fin_handle, TRUE);
  Rf_setAttrib(ptr, R_ClassSymbol, Rf_mkString("curl_handle"));
  UNPROTECT(2);
  ref->handleptr = ptr;
  return ptr;
}

SEXP R_option_types(void){
  int len = 0;
  const struct curl_easyoption *o = NULL;
  while((o = curl_easy_option_next(o))){
    if(!(o->flags & CURLOT_FLAG_ALIAS))
      len++;
  }
  SEXP names = PROTECT(Rf_allocVector(STRSXP, len));
  SEXP values = PROTECT(Rf_allocVector(INTSXP, len));
  SEXP types = PROTECT(Rf_allocVector(INTSXP, len));
  int i = 0;
  while((o = curl_easy_option_next(o))){
    if(!(o->flags & CURLOT_FLAG_ALIAS)){
      SET_STRING_ELT(names, i, Rf_mkChar(o->name ? o->name : "???"));
      INTEGER(values)[i] = o->id;
      INTEGER(types)[i] = o->type;
      i++;
    }
  }

  SEXP out = PROTECT(Rf_allocVector(VECSXP, 3));
  SEXP listnms = PROTECT(Rf_allocVector(STRSXP, 3));
  Rf_setAttrib(out, R_NamesSymbol, listnms);
  SET_VECTOR_ELT(out, 0, names);
  SET_VECTOR_ELT(out, 1, values);
  SET_VECTOR_ELT(out, 2, types);
  SET_STRING_ELT(listnms, 0, Rf_mkChar("name"));
  SET_STRING_ELT(listnms, 1, Rf_mkChar("value"));
  SET_STRING_ELT(listnms, 2, Rf_mkChar("type"));
  UNPROTECT(5);
  return out;
}

SEXP R_proxy_info(void){
  return R_NilValue;
}

SEXP R_split_string(SEXP string, SEXP split){
  const char * str = CHAR(STRING_ELT(string, 0));
  cetype_t enc = Rf_getCharCE(STRING_ELT(string, 0));
  const char * cut = CHAR(STRING_ELT(split, 0));
  char * out = strstr(str, cut);
  if(!out)
    return string;
  SEXP res = PROTECT(Rf_allocVector(STRSXP, 2));
  SET_STRING_ELT(res, 0, Rf_mkCharLenCE(str, out - str, enc));
  SET_STRING_ELT(res, 1, Rf_mkCharCE(out + strlen(cut), enc));
  UNPROTECT(1);
  return res;
}

SEXP R_total_handles(void){
  return(Rf_ScalarInteger(total_handles));
}

SEXP R_total_writers(void){
  return(Rf_ScalarInteger(total_open_writers));
}

SEXP R_windows_build(void){
  DWORD dwBuild = 0;
  DWORD dwVersion = GetVersion();
  if (dwVersion < 0x80000000)
    dwBuild = (DWORD)(HIWORD(dwVersion));
  return Rf_ScalarInteger(dwBuild);
}

SEXP R_write_file_writer(SEXP ptr, SEXP buf, SEXP close){
  FILE *fp = R_ExternalPtrAddr(ptr);
  size_t len = 0;
  if(Rf_length(buf)){
    if(fp == NULL){
      SEXP path = VECTOR_ELT(R_ExternalPtrTag(ptr), 0);
      SEXP append = VECTOR_ELT(R_ExternalPtrTag(ptr), 1);
      fp = fopen(CHAR(STRING_ELT(path, 0)), Rf_asLogical(append) ? "ab" : "wb");
      if(!fp){
        const char *errmsg =  strerror(errno);
        Rf_error("Failed to open file: %s\n%s", CHAR(STRING_ELT(path, 0)), errmsg);
      }
      R_SetExternalPtrAddr(ptr, fp);
      total_open_writers++;
    }
    len = fwrite(RAW(buf), 1, Rf_xlength(buf), fp);
  }
  if(Rf_asLogical(close)){
    fin_file_writer(ptr);
  } else if(Rf_length(buf)) {
    fflush(fp);
  }
  return Rf_ScalarInteger(len);
}

size_t append_buffer(void *contents, size_t sz, size_t nmemb, void *ctx) {
//if (pending_interrupt())
  //  return 0;

  /* avoids compiler warning on windows */
  size_t realsize = sz * nmemb;
  memory *mem = (memory*) ctx;

  /* realloc can be slow, therefore increase buffer to nearest 2^n */
  mem->buf = realloc(mem->buf, round_up(mem->size + realsize));
  if (!mem->buf)
    return 0;

  /* append data and increment size */
  memcpy(&(mem->buf[mem->size]), contents, realsize);
  mem->size += realsize;
  return realsize;
}

void assert_message(CURLcode res, const char *str){
  if(res == CURLE_OK)
    return;
  if(res == CURLE_ABORTED_BY_CALLBACK)
    send_r_interrupt();
  if(str == NULL)
    str = curl_easy_strerror(res);
  SEXP code = PROTECT(Rf_ScalarInteger(res));
  SEXP message = PROTECT(make_string(str));
  SEXP expr = PROTECT(Rf_install("raise_libcurl_error"));
  SEXP call = PROTECT(Rf_lang3(expr, code, message));
  SEXP env = PROTECT(R_FindNamespace(Rf_mkString("curl")));
  Rf_eval(call, env);
  UNPROTECT(5); //never happens
}

static void assert_setopt(CURLcode res, CURLoption opt, const char *optname){
  if(res != CURLE_OK){
    char errmsg [256] = {0};
    if(opt == CURLOPT_MAIL_RCPT || opt == CURLOPT_MAIL_FROM || opt == CURLOPT_MAIL_AUTH){
      snprintf(errmsg, 256, "Error setting '%s': your libcurl may have disabled SMTP support", optname);
    } else {
      snprintf(errmsg, 256, "Invalid or unsupported value when setting curl option '%s'", optname);
    }
    assert_message(CURLE_BAD_FUNCTION_ARGUMENT, errmsg);
  }
}

void assert_status(CURLcode res, reference *ref){
  raise_libcurl_error(res, ref, R_NilValue);
}

void check_interrupt_fn(void *dummy) {
  R_CheckUserInterrupt();
}

void clean_handle(reference *ref){
  if(ref->refCount == 0){
    if(ref->headers)
      curl_slist_free_all(ref->headers);
    if(ref->custom)
      curl_slist_free_all(ref->custom);
    if(ref->form)
      curl_formfree(ref->form);
    if(ref->handle)
      curl_easy_cleanup(ref->handle);
    if(ref->resheaders.buf)
      free(ref->resheaders.buf);
    free(ref);
    total_handles--;
  }
}

CURLcode curl_perform_with_interrupt(CURL *handle){
  /* start settings */
  CURLcode status = CURLE_FAILED_INIT;
  CURLM * temp_multi_handle = NULL;
  CURLM * multi_handle = NULL;
  int still_running = 1;

  /* Do not reuse FTP connections, because it is buggy */
  /* For example https://github.com/jeroen/curl/issues/348 */
  const char *effective_url = NULL;
  curl_easy_getinfo(handle, CURLINFO_EFFECTIVE_URL, &effective_url);
  if(effective_url && str_starts_with(effective_url, "ftp")){
    temp_multi_handle = curl_multi_init();
    multi_handle = temp_multi_handle;
  } else {
    multi_handle = shared_multi_handle;
  }

  if(CURLM_OK != curl_multi_add_handle(multi_handle, handle)){
    return CURLE_FAILED_INIT;
  }

  /* non blocking downloading */
  while(still_running) {
    if(pending_interrupt()){
      status = CURLE_ABORTED_BY_CALLBACK;
      break;
    }

    int numfds;
    if(curl_multi_wait(multi_handle, NULL, 0, 1000, &numfds) != CURLM_OK)
      break;

    /* check for multi errors */
    if(curl_multi_perform(multi_handle, &(still_running)) != CURLM_OK)
      break;
  }

  /* set status if handle has completed. This might be overkill */
  if(!still_running){
    int msgq = 0;
    do {
      CURLMsg *m = curl_multi_info_read(multi_handle, &msgq);
      if(m && (m->msg == CURLMSG_DONE)){
        status = m->data.result;
        break;
      }
    } while (msgq > 0);
  }

  /* cleanup first */
  curl_multi_remove_handle(multi_handle, handle);
  if(temp_multi_handle)
    curl_multi_cleanup(temp_multi_handle);
  return status;
}

size_t data_callback(void * data, size_t sz, size_t nmemb, SEXP fun) {
  size_t size = sz * nmemb;
  SEXP buf = PROTECT(Rf_allocVector(RAWSXP, size));
  memcpy(RAW(buf), data, size);

  /* call the R function */
  int err;
  SEXP call = PROTECT(Rf_lang3(fun, buf, Rf_ScalarInteger(0)));
  R_tryEval(call, R_GlobalEnv, &err);
  UNPROTECT(2);
  return err ? 0 : size;
}

static int default_verbose_cb(CURL *handle, curl_infotype type, char *data, size_t size, void *userptr){
  if(type < 3){
    char prefix = type == CURLINFO_TEXT ? '*' : (type == CURLINFO_HEADER_IN ? '<' : '>');
    REprintf("%c %.*s", prefix, (int) size, data);
  }
  return 0;
}

static size_t dummy_read(char *buffer, size_t size, size_t nitems, void *instream){
  return 0;
}

static void fail_if(CURLUcode err){
  if(err != CURLUE_OK)
#ifdef HAS_CURL_PARSER_STRERROR
    Rf_error("Failed to parse URL: %s", curl_url_strerror(err));
#else
    Rf_error("Failed to parse URL: error code %d", err);
#endif
}

void fin_file_writer(SEXP ptr){
  FILE *fp = R_ExternalPtrAddr(ptr);
  if(fp != NULL){
    fclose(fp);
    R_ClearExternalPtr(ptr);
    total_open_writers--;
  }
}

static void fin_handle(SEXP ptr){
  reference *ref = (reference*) R_ExternalPtrAddr(ptr);

  //this kind of strange but the multi finalizer needs the ptr value
  //if it is still pending
  ref->refCount--;
  if(ref->refCount == 0)
    R_ClearExternalPtr(ptr);

  //free stuff
  clean_handle(ref);
}

CURLM *get_curlm(SEXP ptr){
  CURLM *multi;
  if(Rf_inherits(ptr, "curl")){
    ptr = Rf_getAttrib(ptr, Rf_install("conn_id"));
    if (TYPEOF(ptr) != EXTPTRSXP)
      Rf_error("pool ptr is not a curl connection");
    multi = (CURLM*) R_ExternalPtrAddr(ptr);
    if(!multi)
      Rf_error("CURLM pointer is dead");
  } else {
    multiref *mref = get_multiref(ptr);
    multi = mref->m;
  }
  return multi;
}

static SEXP get_field(CURLU *h, CURLUPart part, CURLUcode field_missing){
  char *str = NULL;
  SEXP field = NULL;
  CURLUcode err = curl_url_get(h, part, &str, 0);
  if(err == field_missing && err != CURLUE_OK){
    field = R_NilValue;
  } else {
    fail_if(err);
    field = make_string(str);
  }
  curl_free(str);
  return field;
}

CURL* get_handle(SEXP ptr){
  return get_ref(ptr)->handle;
}

multiref *get_multiref(SEXP ptr){
  if(TYPEOF(ptr) != EXTPTRSXP || !Rf_inherits(ptr, "curl_multi"))
    Rf_error("pool ptr is not a curl_multi handle");
  multiref *mref = (multiref*) R_ExternalPtrAddr(ptr);
  if(!mref)
    Rf_error("multiref pointer is dead");
  return mref;
}

reference* get_ref(SEXP ptr){
  if(TYPEOF(ptr) != EXTPTRSXP || !Rf_inherits(ptr, "curl_handle"))
    Rf_error("handle is not a curl_handle()");
  if(!R_ExternalPtrAddr(ptr))
    Rf_error("handle is dead");
  reference *ref = (reference*) R_ExternalPtrAddr(ptr);
  return ref;
}

SEXP make_handle_response(reference *ref){
  CURL *handle = ref->handle;
  SEXP res = PROTECT(Rf_allocVector(VECSXP, 10));
  SET_VECTOR_ELT(res, 0, make_info_string(handle, CURLINFO_EFFECTIVE_URL));
  SET_VECTOR_ELT(res, 1, make_info_integer(handle, CURLINFO_RESPONSE_CODE));
  SET_VECTOR_ELT(res, 2, make_info_string(handle, CURLINFO_CONTENT_TYPE));
  SET_VECTOR_ELT(res, 3, make_rawvec(ref->resheaders.buf, ref->resheaders.size));
  SET_VECTOR_ELT(res, 4, make_filetime(handle));
  SET_VECTOR_ELT(res, 5, make_timevec(handle));
  SET_VECTOR_ELT(res, 6, make_info_string(handle, CURLINFO_SCHEME));
  SET_VECTOR_ELT(res, 7, make_info_http_version(handle));
  SET_VECTOR_ELT(res, 8, make_info_string(handle, CURLINFO_EFFECTIVE_METHOD));
  SET_VECTOR_ELT(res, 9, R_NilValue);
  Rf_setAttrib(res, R_NamesSymbol, make_namesvec());
  UNPROTECT(1);
  return res;
}

static SEXP make_info_string(CURL *handle, CURLINFO info){
  char *res_url = NULL;
  assert(curl_easy_getinfo(handle, info, &res_url));
  return make_string(res_url);
}

static SEXP make_namesvec(void){
  SEXP names = PROTECT(Rf_allocVector(STRSXP, 10));
  SET_STRING_ELT(names, 0, Rf_mkChar("url"));
  SET_STRING_ELT(names, 1, Rf_mkChar("status_code"));
  SET_STRING_ELT(names, 2, Rf_mkChar("type"));
  SET_STRING_ELT(names, 3, Rf_mkChar("headers"));
  SET_STRING_ELT(names, 4, Rf_mkChar("modified"));
  SET_STRING_ELT(names, 5, Rf_mkChar("times"));
  SET_STRING_ELT(names, 6, Rf_mkChar("scheme"));
  SET_STRING_ELT(names, 7, Rf_mkChar("http_version"));
  SET_STRING_ELT(names, 8, Rf_mkChar("method"));
  SET_STRING_ELT(names, 9, Rf_mkChar("content"));
  UNPROTECT(1);
  return names;
}

static SEXP make_rawvec(unsigned char *ptr, size_t size){
  SEXP out = PROTECT(Rf_allocVector(RAWSXP, size));
  if(size > 0)
    memcpy(RAW(out), ptr, size);
  UNPROTECT(1);
  return out;
}

static SEXP make_url_names(void){
  SEXP names = PROTECT(Rf_allocVector(STRSXP, 9));
  SET_STRING_ELT(names, 0, Rf_mkChar("url"));
  SET_STRING_ELT(names, 1, Rf_mkChar("scheme"));
  SET_STRING_ELT(names, 2, Rf_mkChar("host"));
  SET_STRING_ELT(names, 3, Rf_mkChar("port"));
  SET_STRING_ELT(names, 4, Rf_mkChar("path"));
  SET_STRING_ELT(names, 5, Rf_mkChar("query"));
  SET_STRING_ELT(names, 6, Rf_mkChar("fragment"));
  SET_STRING_ELT(names, 7, Rf_mkChar("user"));
  SET_STRING_ELT(names, 8, Rf_mkChar("password"));
  UNPROTECT(1);
  return names;
}

void massert(CURLMcode res){
  if(res != CURLM_OK)
    Rf_error("%s", curl_multi_strerror(res));
}

void multi_release(reference *ref){
  /* Release the easy-handle */
  CURL *handle = ref->handle;
  CURLM *multi = ref->async.mref->m;
  massert(curl_multi_remove_handle(multi, handle));
  curl_easy_setopt(handle, CURLOPT_WRITEFUNCTION, NULL);
  curl_easy_setopt(handle, CURLOPT_WRITEDATA, NULL);

  /* Remove the curl handle from the handles list */
  ref->async.mref->handles = reflist_remove(ref->async.mref->handles, ref->handleptr);
  R_SetExternalPtrProtected(ref->async.mref->multiptr, ref->async.mref->handles);
  SET_VECTOR_ELT(R_ExternalPtrProtected(ref->handleptr), 0, R_NilValue);

  /* Reset multi state struct */
  if(ref->async.content.buf){
    free(ref->async.content.buf);
    ref->async.content.buf = NULL;
    ref->async.content.size = 0;
  }
  ref->async.mref = NULL;
  ref->async.content.buf = NULL;
  ref->async.content.size = 0;
  ref->async.complete = NULL;
  ref->async.error = NULL;
  ref->async.data = NULL;
  ref->async.node = NULL;

  /* Unlock handle (and cleanup if needed) */
  ref->locked = 0;
  ref->refCount--;
  clean_handle(ref);
}

int pending_interrupt(void) {
  return !(R_ToplevelExec(check_interrupt_fn, NULL));
}

static size_t pop(void *target, size_t max, request *req){
  size_t copy_size = min(req->size, max);
  memcpy(target, req->cur, copy_size);
  req->cur += copy_size;
  req->size -= copy_size;
  //Rprintf("Requested %d bytes, popped %d bytes, new size %d bytes.\n", max, copy_size, req->size);
  return copy_size;
}

static int process_server(void) {
  return !(R_ToplevelExec(run_httpuv, NULL));
}

size_t push_disk(void* contents, size_t sz, size_t nmemb, FILE *ctx) {
  //if (pending_interrupt())
  //  return 0;
  return fwrite(contents, sz, nmemb, ctx);
}

int r_curl_is_long_option(CURLoption x){
  const curl_easytype type = curl_easy_option_by_id(x)->type;
  return type == CURLOT_LONG || type == CURLOT_VALUES;
}

int r_curl_is_off_t_option(CURLoption x){
  return curl_easy_option_by_id(x)->type == CURLOT_OFF_T;
}

int r_curl_is_postfields_option(CURLoption x){
  return curl_easy_option_by_id(x)->type == CURLOT_OBJECT;
}

int r_curl_is_slist_option(CURLoption x){
  return curl_easy_option_by_id(x)->type == CURLOT_SLIST;
}

int r_curl_is_string_option(CURLoption x){
  return curl_easy_option_by_id(x)->type == CURLOT_STRING;
}

void raise_libcurl_error(CURLcode res, reference *ref, SEXP error_cb){
  if(res == CURLE_OK)
    return;
  if(res == CURLE_ABORTED_BY_CALLBACK)
    send_r_interrupt();
  const char *source_url = NULL;
  curl_easy_getinfo(ref->handle, CURLINFO_EFFECTIVE_URL, &source_url);
  SEXP url = PROTECT(make_string(source_url));
  SEXP code = PROTECT(Rf_ScalarInteger(res));
  SEXP message = PROTECT(make_string(curl_easy_strerror(res)));
  SEXP errbuf = PROTECT(make_string(ref->errbuf));
  SEXP expr = PROTECT(Rf_install("raise_libcurl_error"));
  SEXP call = PROTECT(Rf_lang6(expr, code, message, errbuf, url, error_cb));
  SEXP env = PROTECT(R_FindNamespace(Rf_mkString("curl")));
  Rf_eval(call, env);
  UNPROTECT(7); //happens for non-throwing error_cb()
}

SEXP reflist_add(SEXP x, SEXP target){
  if(!Rf_isPairList(x))
    Rf_error("Not a LISTSXP");
  return(Rf_cons(target, x));
}

SEXP reflist_init(void){
  return R_NilValue;
}

void reset_resheaders(reference *ref){
  if(ref->resheaders.buf)
    free(ref->resheaders.buf);
  ref->resheaders.buf = NULL;
  ref->resheaders.size = 0;
}

static size_t round_up(size_t v){
  if(v == 0)
    return 0;
  v--;
  v |= v >> 1;
  v |= v >> 2;
  v |= v >> 4;
  v |= v >> 8;
  v |= v >> 16;
/* 64 bit only */
#if SIZE_MAX > 4294967296
    v |= v >> 32;
#endif
  return ++v;
}

static void run_httpuv(void *dummy) {
  SEXP expr = PROTECT(Rf_lang1(Rf_install("later_wrapper")));
  SEXP env = PROTECT(R_FindNamespace(Rf_mkString("curl")));
  Rf_eval(expr, env);
  UNPROTECT(2);
}

void send_r_interrupt(void) {
  Rf_onintr();
}

void set_form(reference *ref, struct curl_httppost* newform){
  if(ref->form)
    curl_formfree(ref->form);
  ref->form = newform;
  if(newform){
    assert(curl_easy_setopt(ref->handle, CURLOPT_HTTPPOST, ref->form));
  } else {
    //CURLOPT_HTTPPOST has bug for empty forms. We probably want this:
    assert(curl_easy_setopt(ref->handle, CURLOPT_POSTFIELDS, ""));
  }
}

static void set_handle_defaults(reference *ref){

  /* the actual curl handle */
  CURL *handle = ref->handle;
  assert(curl_easy_setopt(handle, CURLOPT_PRIVATE, ref));

  /* set the response header collector */
  reset_resheaders(ref);
  curl_easy_setopt(handle, CURLOPT_HEADERFUNCTION, append_buffer);
  curl_easy_setopt(handle, CURLOPT_HEADERDATA, &(ref->resheaders));

  /* Respect CURL_CA_BUNDLE like base R, except for Schannel on Windows */
  const char *ca_bundle = getenv("CURL_CA_BUNDLE");
  #ifdef _WIN32
  curl_easy_setopt(handle, CURLOPT_SSL_OPTIONS, CURLSSLOPT_NO_REVOKE);
  struct curl_tlssessioninfo *tlsinfo = NULL;
  if(curl_easy_getinfo(handle, CURLINFO_TLS_SSL_PTR, &tlsinfo) == CURLE_OK){
    if(tlsinfo->backend == CURLSSLBACKEND_OPENSSL && ca_bundle == NULL) {
      curl_easy_setopt(handle, CURLOPT_SSL_OPTIONS, CURLSSLOPT_NO_REVOKE | CURLSSLOPT_NATIVE_CA);
    } else if(tlsinfo->backend == CURLSSLBACKEND_SCHANNEL){
      ca_bundle = NULL;
    }
  }
  #endif

  if(ca_bundle != NULL) {
    curl_easy_setopt(handle, CURLOPT_CAINFO, ca_bundle);
  }

  static const curl_version_info_data *version = NULL;
  if(version == NULL)
    version = curl_version_info(CURLVERSION_NOW);
  /* Enable compression. On MacOS libcurl 8.7.1, deflate is broken, so dont ask for it */
  assert(curl_easy_setopt(handle, CURLOPT_ENCODING, version->version_num == 0x080701 ? "gzip" : ""));

  /* follow redirect */
  assert(curl_easy_setopt(handle, CURLOPT_FOLLOWLOCATION, 1L));
  assert(curl_easy_setopt(handle, CURLOPT_MAXREDIRS, 10L));

  /* a sensible timeout (10s) */
  assert(curl_easy_setopt(handle, CURLOPT_CONNECTTIMEOUT, 10L));

  /* error if download is stalled for 10 minutes (prevent CI hangs) */
  assert(curl_easy_setopt(handle, CURLOPT_LOW_SPEED_LIMIT, 1L));
  assert(curl_easy_setopt(handle, CURLOPT_LOW_SPEED_TIME, 600L));

  /* needed to start the cookie engine */
  assert(curl_easy_setopt(handle, CURLOPT_COOKIEFILE, ""));
  assert(curl_easy_setopt(handle, CURLOPT_FILETIME, 1L));

  /* set the default user agent to match base R */
  SEXP agent = Rf_GetOption1(Rf_install("HTTPUserAgent"));
  if(Rf_isString(agent) && Rf_length(agent)){
    assert(curl_easy_setopt(handle, CURLOPT_USERAGENT, CHAR(STRING_ELT(agent, 0))));
  } else {
    assert(curl_easy_setopt(handle, CURLOPT_USERAGENT, "r/curl/jeroen"));
  }

  /* set the default netrc path to match base R */
  SEXP netrc = Rf_GetOption1(Rf_install("netrc"));
  if (Rf_isString(netrc) && Rf_length(netrc)) {
    const char *path = R_ExpandFileName(CHAR(STRING_ELT(netrc, 0)));
    assert(curl_easy_setopt(handle, CURLOPT_NETRC, CURL_NETRC_OPTIONAL));
    assert(curl_easy_setopt(handle, CURLOPT_NETRC_FILE, path));
  }

  /* allow all authentication methods */
  assert(curl_easy_setopt(handle, CURLOPT_HTTPAUTH, CURLAUTH_ANY));
  assert(curl_easy_setopt(handle, CURLOPT_PROXYAUTH, CURLAUTH_ANY));

  /* set an error buffer */
  assert(curl_easy_setopt(handle, CURLOPT_ERRORBUFFER, ref->errbuf));

  /* dummy readfunction because default can freeze R */
  assert(curl_easy_setopt(handle, CURLOPT_READFUNCTION, dummy_read));

  /* set default progress printer (disabled by default) */
  assert(curl_easy_setopt(handle, CURLOPT_XFERINFOFUNCTION, xferinfo_callback));

  /* Disable the 'Expect: 100' header (deprecated in recent libcurl) */
  set_headers(ref, NULL);
  assert(curl_easy_setopt(handle, CURLOPT_EXPECT_100_TIMEOUT_MS, 0L));

  /* Send verbose outout to R front-end virtual stderr */
  assert(curl_easy_setopt(handle, CURLOPT_DEBUGFUNCTION, default_verbose_cb));

  /* Prefer using multiplex when possible */
  assert(curl_easy_setopt(handle, CURLOPT_PIPEWAIT, 1L));
}

static void set_headers(reference *ref, struct curl_slist *newheaders){
  if(ref->headers)
    curl_slist_free_all(ref->headers);
  ref->headers = newheaders;
  assert(curl_easy_setopt(ref->handle, CURLOPT_HTTPHEADER,
                          newheaders ? newheaders : default_headers()));
}

static void set_value(CURLU *h, CURLUPart part, SEXP value){
  if(Rf_length(value) && Rf_isString(value)){
    if(STRING_ELT(value, 0) == NA_STRING || Rf_length(STRING_ELT(value, 0)) == 0){
      fail_if(curl_url_set(h, part, NULL, 0));
    } else if(Rf_inherits(value, "AsIs")){
      fail_if(curl_url_set(h, part, get_string(value), 0));
    } else {
      fail_if(curl_url_set(h, part, get_string(value), CURLU_NON_SUPPORT_SCHEME | CURLU_URLENCODE));
    }
  }
}

SEXP slist_to_vec(struct curl_slist *slist){
  /* linked list of strings */
  struct curl_slist *cursor = slist;

  /* count slist */
  int n = 0;
  while (cursor) {
    n++;
    cursor = cursor->next;
  }

  SEXP out = PROTECT(Rf_allocVector(STRSXP, n));
  cursor = slist;
  for(int i = 0; i < n; i++){
    SET_STRING_ELT(out, i, Rf_mkChar(cursor->data));
    cursor = cursor->next;
  }
  UNPROTECT(1);
  return out;
}

static int str_starts_with(const char *a, const char *b) {
  if(strncmp(a, b, strlen(b)) == 0) return 1;
  return 0;
}

static void syserror_if(int err, const char * what){
  if(err)
    Rf_errorcall(R_NilValue, "System failure for: %s (%s)", what, getsyserror());
}

static size_t write_nothing(void *contents, size_t sz, size_t nmemb, void *ctx) {
  return sz * nmemb;
}

static int xferinfo_callback(void *clientp, xftype dltotal, xftype dlnow, xftype ultotal, xftype ulnow){
  static xftype dlprev = 0;
  static xftype ulprev = 0;
  if(dlnow && dlnow != dlprev){
    dlprev = dlnow;
    if(dltotal){
      int pct_dn = (100 * dlnow)/dltotal;
      REprintf("\r [%d%%] Downloaded %.0lf bytes...", pct_dn, (double) dlnow);
      if(dlnow == dltotal)
        REprintf("\n");
    } else {
      REprintf("\r Downloaded %.0lf bytes...", (double) dlnow);
    }
  } else if(ulnow && ulnow != ulprev){
    ulprev = ulnow;
    int pct_up = (100 * ulnow)/ultotal;
    REprintf("\r [%d%%] Uploaded %.0lf bytes...", pct_up, (double) ulnow);
    if(ulnow == ultotal)
      REprintf("\n");
  }
  return 0;
}

SEXP R_curl_escape(SEXP url, SEXP unescape_) {
  if (!Rf_isString(url))
    Rf_error("`url` must be a character vector.");
  CURL *handle = curl_easy_init();
  int n = Rf_length(url);
  SEXP output = PROTECT(Rf_allocVector(STRSXP, n));

  for (int i = 0; i < n; i++) {
    const char *input = CHAR(STRING_ELT(url, i));
    char *out = Rf_asLogical(unescape_) ?
      curl_easy_unescape(handle, input, 0, NULL) : curl_easy_escape(handle, input, 0);
    if(out != NULL){
      SET_STRING_ELT(output, i, Rf_mkCharCE(out, CE_UTF8));
      curl_free(out);
    }
  }
  curl_easy_cleanup(handle);
  UNPROTECT(1);
  return output;
}

SEXP R_curl_getdate(SEXP datestring) {
  if(!Rf_isString(datestring))
    Rf_error("Argument 'datestring' must be string.");

  int len = Rf_length(datestring);
  SEXP out = PROTECT(Rf_allocVector(INTSXP, len));

  for(int i = 0; i < len; i++){
    time_t date = curl_getdate(CHAR(STRING_ELT(datestring, i)), NULL);
    INTEGER(out)[i] = date < 0 ? NA_INTEGER : (int) date;
  }
  UNPROTECT(1);
  return out;
}

SEXP R_curl_version(void) {
  /* retrieve info from curl */
  const curl_version_info_data *data = curl_version_info(CURLVERSION_NOW);

  /* put stuff in a list */
  SEXP list = PROTECT(Rf_allocVector(VECSXP, 12));
  SET_VECTOR_ELT(list, 0, make_string(data->version));
  SET_VECTOR_ELT(list, 1, make_string(LIBCURL_VERSION));
  SET_VECTOR_ELT(list, 2, make_string(data->ssl_version));
  SET_VECTOR_ELT(list, 3, make_string(data->libz_version));
  SET_VECTOR_ELT(list, 4, make_string(data->libssh_version));
  SET_VECTOR_ELT(list, 5, make_string(data->libidn));
  SET_VECTOR_ELT(list, 6, make_string(data->host));

  /* create vector of protocols */
  int len = 0;
  const char *const * temp = data->protocols;
  while(*temp++) len++;
  SEXP protocols = PROTECT(Rf_allocVector(STRSXP, len));
  for (int i = 0; i < len; i++){
    SET_STRING_ELT(protocols, i, Rf_mkChar(*(data->protocols + i)));
  }
  SET_VECTOR_ELT(list, 7, protocols);

  /* add list names */
  SEXP names = PROTECT(Rf_allocVector(STRSXP, 12));
  SET_STRING_ELT(names, 0, Rf_mkChar("version"));
  SET_STRING_ELT(names, 1, Rf_mkChar("headers"));
  SET_STRING_ELT(names, 2, Rf_mkChar("ssl_version"));
  SET_STRING_ELT(names, 3, Rf_mkChar("libz_version"));
  SET_STRING_ELT(names, 4, Rf_mkChar("libssh_version"));
  SET_STRING_ELT(names, 5, Rf_mkChar("libidn_version"));
  SET_STRING_ELT(names, 6, Rf_mkChar("host"));
  SET_STRING_ELT(names, 7, Rf_mkChar("protocols"));
  SET_STRING_ELT(names, 8, Rf_mkChar("ipv6"));
  SET_STRING_ELT(names, 9, Rf_mkChar("http2"));
  SET_STRING_ELT(names, 10, Rf_mkChar("idn"));
  SET_STRING_ELT(names, 11, Rf_mkChar("url_parser"));
  Rf_setAttrib(list, R_NamesSymbol, names);

  #ifdef CURL_VERSION_IPV6
  SET_VECTOR_ELT(list, 8, Rf_ScalarLogical(data->features & CURL_VERSION_IPV6));
  #else
  SET_VECTOR_ELT(list, 8, Rf_ScalarLogical(0));
  #endif

  #ifdef CURL_VERSION_HTTP2
  SET_VECTOR_ELT(list, 9, Rf_ScalarLogical(data->features & CURL_VERSION_HTTP2));
  #else
  SET_VECTOR_ELT(list, 9, Rf_ScalarLogical(0));
  #endif

  #ifdef CURL_VERSION_IDN
    SET_VECTOR_ELT(list, 10, Rf_ScalarLogical(data->features & CURL_VERSION_IDN));
  #else
    SET_VECTOR_ELT(list, 10, Rf_ScalarLogical(0));
  #endif

  // CURL_PARSER is always assumed to be available
  SET_VECTOR_ELT(list, 11, Rf_ScalarLogical(1));


  /* return */
  UNPROTECT(3);
  return list;
}

SEXP R_modify_url(SEXP url, SEXP scheme, SEXP host, SEXP port, SEXP path, SEXP query, SEXP fragment, SEXP user, SEXP password){
  CURLU *h = curl_url();
  set_value(h, CURLUPART_URL, url);
  set_value(h, CURLUPART_SCHEME, scheme);
  set_value(h, CURLUPART_HOST, host);
  set_value(h, CURLUPART_PORT, port);
  set_value(h, CURLUPART_PATH, path);
  set_value(h, CURLUPART_QUERY, query);
  set_value(h, CURLUPART_FRAGMENT, fragment);
  set_value(h, CURLUPART_USER, user);
  set_value(h, CURLUPART_PASSWORD, password);
  char *str = NULL;
  fail_if(curl_url_get(h, CURLUPART_URL, &str, 0));
  SEXP out = make_string(str);
  curl_free(str);
  return out;
}

SEXP R_multi_add(SEXP handle_ptr, SEXP cb_complete, SEXP cb_error, SEXP cb_data, SEXP pool_ptr){
  multiref *mref = get_multiref(pool_ptr);
  CURLM *multi = mref->m;

  reference *ref = get_ref(handle_ptr);
  if(ref->locked)
    Rf_error("Handle is locked. Probably in use in a connection or async request.");

  /* placeholder body */
  if(Rf_isFunction(cb_data)){
    curl_easy_setopt(ref->handle, CURLOPT_WRITEFUNCTION, (curl_write_callback) data_callback);
    curl_easy_setopt(ref->handle, CURLOPT_WRITEDATA, cb_data);
  } else {
    curl_easy_setopt(ref->handle, CURLOPT_WRITEFUNCTION, append_buffer);
    curl_easy_setopt(ref->handle, CURLOPT_WRITEDATA, &(ref->async.content));
  }

  /* add to scheduler */
  massert(curl_multi_add_handle(multi, ref->handle));

  /* create node in ref */
  ref->async.mref = mref;
  mref->handles = reflist_add(mref->handles, handle_ptr);
  R_SetExternalPtrProtected(pool_ptr, mref->handles);

  /* set multi callbacks */
  ref->async.complete = cb_complete;
  ref->async.error = cb_error;
  ref->async.data = cb_data;
  SET_VECTOR_ELT(R_ExternalPtrProtected(handle_ptr), 0,
                 Rf_list3(cb_error, cb_complete, cb_data));

  /* lock and protect handle */
  ref->refCount++;
  ref->locked = 1;
  return handle_ptr;
}

SEXP R_multi_fdset(SEXP pool_ptr){
  CURLM *multi = get_curlm(pool_ptr);
  fd_set read_fd_set, write_fd_set, exc_fd_set;
  int max_fd, i, num_read = 0, num_write = 0, num_exc = 0;
  int *pread, *pwrite, *pexc;
  long timeout;
  SEXP result, names;

  FD_ZERO(&read_fd_set);
  FD_ZERO(&write_fd_set);
  FD_ZERO(&exc_fd_set);

  massert(curl_multi_fdset(multi, &read_fd_set, &write_fd_set,
			   &exc_fd_set, &max_fd));

  massert(curl_multi_timeout(multi, &timeout));

  for (i = 0; i <= max_fd; i++){
    if (FD_ISSET(i, &read_fd_set))  num_read++;
    if (FD_ISSET(i, &write_fd_set)) num_write++;
    if (FD_ISSET(i, &exc_fd_set))   num_exc++;
  }

  result = PROTECT(Rf_allocVector(VECSXP, 4));
  SET_VECTOR_ELT(result, 0, Rf_allocVector(INTSXP, num_read));
  SET_VECTOR_ELT(result, 1, Rf_allocVector(INTSXP, num_write));
  SET_VECTOR_ELT(result, 2, Rf_allocVector(INTSXP, num_exc));
  SET_VECTOR_ELT(result, 3, Rf_ScalarReal((double) timeout));

  names = PROTECT(Rf_allocVector(STRSXP, 4));
  SET_STRING_ELT(names, 0, Rf_mkChar("reads"));
  SET_STRING_ELT(names, 1, Rf_mkChar("writes"));
  SET_STRING_ELT(names, 2, Rf_mkChar("exceptions"));
  SET_STRING_ELT(names, 3, Rf_mkChar("timeout"));
  Rf_setAttrib(result, R_NamesSymbol, names);

  pread  = INTEGER(VECTOR_ELT(result, 0));
  pwrite = INTEGER(VECTOR_ELT(result, 1));
  pexc   = INTEGER(VECTOR_ELT(result, 2));

  for (i = 0; i <= max_fd; i++){
    if (FD_ISSET(i, &read_fd_set))  *(pread++)  = i;
    if (FD_ISSET(i, &write_fd_set)) *(pwrite++) = i;
    if (FD_ISSET(i, &exc_fd_set))   *(pexc++)   = i;
  }

  UNPROTECT(2);
  return result;
}

SEXP R_multi_new(void){
  multiref *ref = calloc(1, sizeof(multiref));
  ref->m = curl_multi_init();
  ref->handles = reflist_init();
  SEXP ptr = PROTECT(R_MakeExternalPtr(ref, R_NilValue, ref->handles));
  ref->multiptr = ptr;
  R_RegisterCFinalizerEx(ptr, fin_multi, 1);
  Rf_setAttrib(ptr, R_ClassSymbol, Rf_mkString("curl_multi"));
  UNPROTECT(1);
  return ptr;
}

SEXP R_multi_run(SEXP pool_ptr, SEXP timeout, SEXP max){
  multiref *mref = get_multiref(pool_ptr);
  CURLM *multi = mref->m;

  int total_pending = -1;
  int total_success = 0;
  int total_fail = 0;
  int result_max = Rf_asInteger(max);
  double time_max = Rf_asReal(timeout);
  time_t time_start = time(NULL);

  double seconds_elapsed = 0;
  while(1) {
    /* check for completed requests */
    int dirty = 0;
    int msgq = 1;
    while (msgq > 0) {
      CURLMsg *m = curl_multi_info_read(multi, &msgq);
      if(m && (m->msg == CURLMSG_DONE)){
        dirty = 1;
        reference *ref = NULL;
        CURL *handle = m->easy_handle;
        CURLcode status = m->data.result;
        assert(curl_easy_getinfo(handle, CURLINFO_PRIVATE, (char**) &ref));

        // prepare for callback
        SEXP cb_complete = PROTECT(ref->async.complete);
        SEXP cb_error = PROTECT(ref->async.error);
        SEXP cb_data = PROTECT(ref->async.data);
        SEXP buf = PROTECT(Rf_allocVector(RAWSXP, ref->async.content.size));
        if(ref->async.content.buf && ref->async.content.size)
          memcpy(RAW(buf), ref->async.content.buf, ref->async.content.size);

        //release handle for use by callbacks
        multi_release(ref);

        // Trigger a final 'data' with second argument to TRUE
        // This also ensures that a file is consistently created, even for empty responses
        if(Rf_isFunction(cb_data)){
          SEXP buf = PROTECT(Rf_allocVector(RAWSXP, 0));
          SEXP call = PROTECT(Rf_lang3(cb_data, buf, Rf_ScalarInteger(1)));
          Rf_eval(call, R_GlobalEnv);
          UNPROTECT(2);
        }

        // callbacks must be trycatch! we should continue the loop
        if(status == CURLE_OK){
          total_success++;
          if(Rf_isFunction(cb_complete)){
            int arglen = Rf_length(R_ClosureFormals(cb_complete));
            SEXP out = PROTECT(make_handle_response(ref));
            SET_VECTOR_ELT(out, 9, buf);
            SEXP call = PROTECT(Rf_lcons(cb_complete, arglen ? Rf_lcons(out, R_NilValue) : R_NilValue));
            //R_tryEval(call, R_GlobalEnv, &cbfail);
            Rf_eval(call, R_GlobalEnv); //OK to error here
            UNPROTECT(2);
          }
        } else {
          total_fail++;
          if(Rf_isFunction(cb_error)){
            raise_libcurl_error(status, ref, cb_error);
          }
        }
        UNPROTECT(4);
      }
      R_CheckUserInterrupt();
    }

    /* check for user interruptions */
    //if(pending_interrupt())  break;
    R_CheckUserInterrupt();

    /* check for timeout or max result*/
    if(total_pending > 0 && result_max > 0 && total_success + total_fail >= result_max)
      break;
    if(time_max == 0 && total_pending != -1)
      break;
    if(time_max > 0){
      seconds_elapsed = (double) (time(NULL) - time_start);
      if(seconds_elapsed > time_max)
        break;
    }

    /* check if we are done */
    if(total_pending == 0 && !dirty)
      break;

    int numfds;
    double waitforit = fmin(time_max - seconds_elapsed, 1); //at most 1 sec to support interrupts
    if(time_max > 0)
      massert(curl_multi_wait(multi, NULL, 0, (int) waitforit * 1000, &numfds));

    /* poll libcurl for new data - updates total_pending */
    if(curl_multi_perform(multi, &(total_pending)) != CURLM_OK)
      break;
  }

  SEXP res = PROTECT(Rf_allocVector(VECSXP, 3));
  SET_VECTOR_ELT(res, 0, Rf_ScalarInteger(total_success));
  SET_VECTOR_ELT(res, 1, Rf_ScalarInteger(total_fail));
  SET_VECTOR_ELT(res, 2, Rf_ScalarInteger(total_pending));

  SEXP names = PROTECT(Rf_allocVector(STRSXP, 3));
  SET_STRING_ELT(names, 0, Rf_mkChar("success"));
  SET_STRING_ELT(names, 1, Rf_mkChar("error"));
  SET_STRING_ELT(names, 2, Rf_mkChar("pending"));
  Rf_setAttrib(res, R_NamesSymbol, names);
  UNPROTECT(2);
  return res;
}

SEXP R_multi_setopt(SEXP pool_ptr, SEXP total_con, SEXP host_con, SEXP max_streams, SEXP multiplex){
    CURLM *multi = get_multiref(pool_ptr)->m;
    massert(curl_multi_setopt(multi, CURLMOPT_MAX_TOTAL_CONNECTIONS, (long) Rf_asInteger(total_con)));
    massert(curl_multi_setopt(multi, CURLMOPT_MAX_HOST_CONNECTIONS, (long) Rf_asInteger(host_con)));
    massert(curl_multi_setopt(multi, CURLMOPT_PIPELINING,
                              Rf_asLogical(multiplex) ? CURLPIPE_MULTIPLEX : CURLPIPE_NOTHING));
    massert(curl_multi_setopt(multi, CURLMOPT_MAX_CONCURRENT_STREAMS, (long) Rf_asInteger(max_streams)));
  return pool_ptr;
}

SEXP R_new_file_writer(SEXP opts){
  SEXP ptr = PROTECT(R_MakeExternalPtr(NULL, opts, R_NilValue));
  R_RegisterCFinalizerEx(ptr, fin_file_writer, TRUE);
  Rf_setAttrib(ptr, R_ClassSymbol, Rf_mkString("file_writer"));
  UNPROTECT(1);
  return ptr;
}

SEXP R_nslookup(SEXP hostname, SEXP ipv4_only) {
  /* Because gethostbyname() is deprecated */
  struct addrinfo hints = {0};
  if(Rf_asLogical(ipv4_only))
    hints.ai_family = AF_INET; //only allow ipv4
  struct addrinfo *addr;
  const char * hoststr = CHAR(STRING_ELT(hostname, 0));
#ifdef _WIN32
  if(Rf_getCharCE(STRING_ELT(hostname, 0)) == CE_UTF8){
    char * punycode;
    if(jeroen_win32_idn_to_ascii(hoststr, &punycode))
      hoststr = punycode;
  }
#endif
  if(getaddrinfo(hoststr, NULL, &hints, &addr))
    return R_NilValue;

  // count number of hits
  int len = 0;
  struct addrinfo * cur = addr;
  while(cur != NULL){
    len++;
    cur = cur->ai_next;
  }

  //allocate output
  SEXP out = PROTECT(Rf_allocVector(STRSXP, len));

  //extract the values
  cur = addr;
  for(size_t i = 0; i < len; i++) {
    struct sockaddr *sa = cur->ai_addr;

    /* IPv4 vs v6 */
    char ip[INET6_ADDRSTRLEN];
    if (sa->sa_family == AF_INET) {
      struct sockaddr_in *sa_in = (struct sockaddr_in*) sa;
      inet_ntop(AF_INET, &(sa_in->sin_addr), ip, INET_ADDRSTRLEN);
    } else {
      struct sockaddr_in6 *sa_in = (struct sockaddr_in6*) sa;
      inet_ntop(AF_INET6, &(sa_in->sin6_addr), ip, INET6_ADDRSTRLEN);
    }
    SET_STRING_ELT(out, i, Rf_mkChar(ip));
    cur = cur->ai_next;
  }
  UNPROTECT(1);
  freeaddrinfo(addr);
  return out;
}

SEXP R_parse_url(SEXP url, SEXP baseurl, SEXP default_https) {
  CURLU *h = curl_url();
  int default_scheme = Rf_length(default_https) && Rf_asLogical(default_https);
  if(Rf_length(baseurl)){
    set_url(h, get_string(baseurl), default_scheme);
  }
  set_url(h, get_string(url), default_scheme);
  SEXP out = PROTECT(Rf_allocVector(VECSXP, 9));
  SET_VECTOR_ELT(out, 0, get_field(h, CURLUPART_URL, CURLUE_OK));
  SET_VECTOR_ELT(out, 1, get_field(h, CURLUPART_SCHEME, CURLUE_NO_SCHEME));
  SET_VECTOR_ELT(out, 2, get_field(h, CURLUPART_HOST, CURLUE_NO_HOST));
  SET_VECTOR_ELT(out, 3, get_field(h, CURLUPART_PORT, CURLUE_NO_PORT));
  SET_VECTOR_ELT(out, 4, get_field(h, CURLUPART_PATH, CURLUE_OK));
  SET_VECTOR_ELT(out, 5, get_field(h, CURLUPART_QUERY, CURLUE_NO_QUERY));
  SET_VECTOR_ELT(out, 6, get_field(h, CURLUPART_FRAGMENT, CURLUE_NO_FRAGMENT));
  SET_VECTOR_ELT(out, 7, get_field(h, CURLUPART_USER, CURLUE_NO_USER));
  SET_VECTOR_ELT(out, 8, get_field(h, CURLUPART_PASSWORD, CURLUE_NO_PASSWORD));
  curl_url_cleanup(h);
  Rf_setAttrib(out, R_NamesSymbol, make_url_names());
  UNPROTECT(1);
  return out;
}

static void check_handles(CURLM *manager, reference *ref) {
  for(int msg = 1; msg > 0;){
    CURLMsg *out = curl_multi_info_read(manager, &msg);
    if(out)
      assert_status(out->data.result, ref);
  }
}

static void cleanup(Rconnection con) {
  request *req = (request*) con->private;
  reference *ref = req->ref;

  /* free thee handle connection */
  curl_multi_remove_handle(req->manager, req->handle);
  curl_easy_setopt(req->handle, CURLOPT_WRITEFUNCTION, NULL);
  curl_easy_setopt(req->handle, CURLOPT_WRITEDATA, NULL);
  curl_easy_setopt(req->handle, CURLOPT_FAILONERROR, 0L);
  ref->locked = 0;

  /* delayed finalizer cleanup */
  (ref->refCount)--;
  clean_handle(ref);

  /* clean up connection */
  curl_multi_cleanup(req->manager);
  free(req->buf);
  free(req->url);
  free(req);
}

static struct curl_slist * default_headers(void){
  static struct curl_slist * headers = NULL;
  if(headers == NULL){
    headers = curl_slist_append(headers, "Expect:");
  }
  return headers;
}

static void fetchdata(request *req) {
  R_CheckUserInterrupt();
  massert(curl_multi_perform(req->manager, &(req->has_more)));
  check_handles(req->manager, req->ref);
}

void fin_multi(SEXP ptr){
  multiref *mref = get_multiref(ptr);
  SEXP handles = mref->handles;
  while(handles != R_NilValue){
    multi_release(get_ref(CAR(handles)));
    handles = CDR(handles);
  }
  curl_multi_cleanup(mref->m);
  free(mref);
  R_ClearExternalPtr(ptr);
}

static SEXP make_cookievec(CURL *handle){
  /* linked list of strings */
  struct curl_slist *cookies;
  assert(curl_easy_getinfo(handle, CURLINFO_COOKIELIST, &cookies));
  SEXP out = slist_to_vec(cookies);
  curl_slist_free_all(cookies);
  return out;
}

static SEXP make_filetime(CURL *handle){
  long filetime;
  assert(curl_easy_getinfo(handle, CURLINFO_FILETIME, &filetime));
  if(filetime < 0){
    filetime = NA_INTEGER;
  }

  SEXP classes = PROTECT(Rf_allocVector(STRSXP, 2));
  SET_STRING_ELT(classes, 0, Rf_mkChar("POSIXct"));
  SET_STRING_ELT(classes, 1, Rf_mkChar("POSIXt"));

  SEXP out = PROTECT(Rf_ScalarInteger(filetime));
  Rf_setAttrib(out, R_ClassSymbol, classes);
  UNPROTECT(2);
  return out;
}

struct curl_httppost* make_form(SEXP form){
  struct curl_httppost* post = NULL;
  struct curl_httppost* last = NULL;
  SEXP ln = PROTECT(Rf_getAttrib(form, R_NamesSymbol));
  for(int i = 0; i < Rf_length(form); i++){
    const char *name = Rf_translateCharUTF8(STRING_ELT(ln, i));
    SEXP val = VECTOR_ELT(form, i);
    if(TYPEOF(val) == RAWSXP){
      long datalen = Rf_length(val);
      if(datalen > 0){
        unsigned char * data = RAW(val);
        curl_formadd(&post, &last, CURLFORM_COPYNAME, name, CURLFORM_COPYCONTENTS, data, CURLFORM_CONTENTSLENGTH, datalen, CURLFORM_END);
      } else {
        //Note if 'CURLFORM_CONTENTLEN == 0' then libcurl assumes strlen() !
        curl_formadd(&post, &last, CURLFORM_COPYNAME, name, CURLFORM_COPYCONTENTS, "", CURLFORM_END);
      }
    } else if(Rf_isVector(val) && Rf_length(val)){
      if(Rf_isString(VECTOR_ELT(val, 0))){
        //assume a form_file upload
        const char *path = CHAR(Rf_asChar(VECTOR_ELT(val, 0)));
        if(Rf_isString(VECTOR_ELT(val, 1))) {
          const char *content_type = CHAR(Rf_asChar(VECTOR_ELT(val, 1)));
          if(Rf_isString(VECTOR_ELT(val, 2))) {
            const char *file_name = CHAR(Rf_asChar(VECTOR_ELT(val, 2)));
            curl_formadd(&post, &last, CURLFORM_COPYNAME, name, CURLFORM_FILE, path, CURLFORM_CONTENTTYPE, content_type, CURLFORM_FILENAME, file_name, CURLFORM_END);
          } else {
            curl_formadd(&post, &last, CURLFORM_COPYNAME, name, CURLFORM_FILE, path, CURLFORM_CONTENTTYPE, content_type, CURLFORM_END);
          }
        } else {
          if(Rf_isString(VECTOR_ELT(val, 2))) {
            const char *file_name = CHAR(Rf_asChar(VECTOR_ELT(val, 2)));
            curl_formadd(&post, &last, CURLFORM_COPYNAME, name, CURLFORM_FILE, path, CURLFORM_FILENAME, file_name, CURLFORM_END);
          } else {
            curl_formadd(&post, &last, CURLFORM_COPYNAME, name, CURLFORM_FILE, path, CURLFORM_END);
          }
        }
      } else {
        //assume a form_value upload
        unsigned char * data = RAW(VECTOR_ELT(val, 0));
        long datalen = Rf_length(VECTOR_ELT(val, 0));
        if(Rf_isString(VECTOR_ELT(val, 1))){
          const char * content_type = CHAR(Rf_asChar(VECTOR_ELT(val, 1)));
          curl_formadd(&post, &last, CURLFORM_COPYNAME, name, CURLFORM_COPYCONTENTS, data, CURLFORM_CONTENTSLENGTH, datalen, CURLFORM_CONTENTTYPE, content_type, CURLFORM_END);
        } else {
          curl_formadd(&post, &last, CURLFORM_COPYNAME, name, CURLFORM_COPYCONTENTS, data, CURLFORM_CONTENTSLENGTH, datalen, CURLFORM_END);
        }
      }
    } else {
      Rf_error("form value %s not supported", name);
    }
  }
  UNPROTECT(1);
  return post;
}

static SEXP make_info_http_version(CURL * handle){
  long res = 0;
  assert(curl_easy_getinfo(handle, CURLINFO_HTTP_VERSION, &res));
  switch (res) {
  case CURL_HTTP_VERSION_1_0:
  case CURL_HTTP_VERSION_1_1:
    return Rf_ScalarInteger(1);
  case CURL_HTTP_VERSION_2_0:
    return Rf_ScalarInteger(2);
  case CURL_HTTP_VERSION_3:
    return Rf_ScalarInteger(3);
  default:
    return Rf_ScalarInteger(NA_INTEGER);
  }
}

static SEXP make_info_integer(CURL *handle, CURLINFO info){
  long res_status;
  assert(curl_easy_getinfo(handle, info, &res_status));
  return Rf_ScalarInteger(res_status);
}

static SEXP make_timevec(CURL *handle){
  double time_redirect, time_lookup, time_connect, time_pre, time_start, time_total;
  assert(curl_easy_getinfo(handle, CURLINFO_REDIRECT_TIME, &time_redirect));
  assert(curl_easy_getinfo(handle, CURLINFO_NAMELOOKUP_TIME, &time_lookup));
  assert(curl_easy_getinfo(handle, CURLINFO_CONNECT_TIME, &time_connect));
  assert(curl_easy_getinfo(handle, CURLINFO_PRETRANSFER_TIME, &time_pre));
  assert(curl_easy_getinfo(handle, CURLINFO_STARTTRANSFER_TIME, &time_start));
  assert(curl_easy_getinfo(handle, CURLINFO_TOTAL_TIME, &time_total));

  SEXP result = PROTECT(Rf_allocVector(REALSXP, 6));
  REAL(result)[0] = time_redirect;
  REAL(result)[1] = time_lookup;
  REAL(result)[2] = time_connect;
  REAL(result)[3] = time_pre;
  REAL(result)[4] = time_start;
  REAL(result)[5] = time_total;

  SEXP names = PROTECT(Rf_allocVector(STRSXP, 6));
  SET_STRING_ELT(names, 0, Rf_mkChar("redirect"));
  SET_STRING_ELT(names, 1, Rf_mkChar("namelookup"));
  SET_STRING_ELT(names, 2, Rf_mkChar("connect"));
  SET_STRING_ELT(names, 3, Rf_mkChar("pretransfer"));
  SET_STRING_ELT(names, 4, Rf_mkChar("starttransfer"));
  SET_STRING_ELT(names, 5, Rf_mkChar("total"));
  Rf_setAttrib(result, R_NamesSymbol, names);
  UNPROTECT(2);
  return result;
}

static int port_is_available(int port){

  // define server socket
  struct sockaddr_in serv_addr;
  memset(&serv_addr, '0', sizeof(serv_addr));
  serv_addr.sin_family = AF_INET;
  serv_addr.sin_addr.s_addr = htonl(INADDR_ANY);
  serv_addr.sin_port = htons(port);

  //creates the listening socket
  int sockfd = socket(AF_INET, SOCK_STREAM, 0);
  syserror_if(sockfd < 0, "socket()");

  //Allows immediate reuse of a port in TIME_WAIT state.
  //for Windows see TcpTimedWaitDelay (doesn't work)
#ifndef _WIN32
  int enable = 1;
  syserror_if(setsockopt(sockfd, SOL_SOCKET, SO_REUSEADDR, &enable, sizeof(int)) < 0, "SO_REUSEADDR");
#endif

  int res = bind(sockfd, (struct sockaddr*)&serv_addr, sizeof(serv_addr));
  #ifdef _WIN32
  closesocket(sockfd);
  #else
  close(sockfd);
  #endif
  return res == 0;
}

static size_t push(void *contents, size_t sz, size_t nmemb, void *ctx) {
  /* avoids compiler warning on windows */
  request* req = (request*) ctx;
  req->has_data = 1;

  /* move existing data to front of buffer (if any) */
  memmove(req->buf, req->cur, req->size);

  /* allocate more space if required */
  size_t realsize = sz * nmemb;
  size_t newsize = req->size + realsize;
  while(newsize > req->limit) {
    size_t newlimit = 2 * req->limit;
    //Rprintf("Resizing buffer to %d.\n", newlimit);
    void *newbuf = realloc(req->buf, newlimit);
    if(!newbuf)
      Rf_error("Failure in realloc. Out of memory?");
    req->buf = newbuf;
    req->limit = newlimit;
  }

  /* append new data */
  memcpy(req->buf + req->size, contents, realsize);
  req->size = newsize;
  req->cur = req->buf;
  return realsize;
}

static int rcurl_fgetc(Rconnection con) {
  int x = 0;
#ifdef WORDS_BIGENDIAN
  return rcurl_read(&x, 1, 1, con) ? BSWAP_32(x) : R_EOF;
#else
  return rcurl_read(&x, 1, 1, con) ? x : R_EOF;
#endif
}

static Rboolean rcurl_open(Rconnection con) {
  request *req = (request*) con->private;

  //same message as base::url()
  if (con->mode[0] != 'r' || strchr(con->mode, 'w'))
    Rf_error("can only open URLs for reading");

  if(req->ref->locked)
    Rf_error("Handle is already in use elsewhere.");

  /* init a multi stack with callback */
  CURL *handle = req->handle;
  assert(curl_easy_setopt(handle, CURLOPT_URL, req->url));
  assert(curl_easy_setopt(handle, CURLOPT_WRITEFUNCTION, push));
  assert(curl_easy_setopt(handle, CURLOPT_WRITEDATA, req));

  /* add the handle to the pool and lock it */
  massert(curl_multi_add_handle(req->manager, handle));
  req->ref->locked = 1;

  /* reset the state */
  req->handle = handle;
  req->cur = req->buf;
  req->size = 0;
  req->used = 1;
  req->has_data = 0;
  req->has_more = 1;

  /* fully non-blocking has 's' in open mode */
  int block_open = strchr(con->mode, 's') == NULL;
  int force_open = strchr(con->mode, 'f') != NULL;
  if(block_open && !force_open)
    curl_easy_setopt(handle, CURLOPT_FAILONERROR, 1L);

 /* Wait for first data to arrive. Monitoring a change in status code does not
   suffice in case of http redirects */
  while(block_open && req->has_more && !req->has_data) {
    int numfds;
    massert(curl_multi_wait(req->manager, NULL, 0, 1000, &numfds));
    if(pending_interrupt()) {
      reset(con); //cleanup before jumping
      assert_message(CURLE_ABORTED_BY_CALLBACK, NULL);
    }
    massert(curl_multi_perform(req->manager, &(req->has_more)));
    for(int msg = 1; msg > 0;){
      CURLMsg *out = curl_multi_info_read(req->manager, &msg);
      if(out && out->data.result != CURLE_OK){
        const char *errmsg = strlen(req->ref->errbuf) ? req->ref->errbuf : curl_easy_strerror(out->data.result);
        Rf_warningcall(R_NilValue, "Failed to open '%s': %s", req->url, errmsg);
        reset(con);
        return FALSE;
      }
    }
  }

  /* check http status code */
  /* Stream connections should be checked via handle_data() */
  /* Non-blocking open connections get checked during read */

  /* set mode in case open() changed it */
  con->text = strchr(con->mode, 'b') ? FALSE : TRUE;
  con->isopen = TRUE;
  con->incomplete = TRUE;
  return TRUE;
}

static size_t rcurl_read(void *target, size_t sz, size_t ni, Rconnection con) {
  request *req = (request*) con->private;
  size_t req_size = sz * ni;
  size_t total_size = pop(target, req_size, req);
  if (total_size > 0 && (!con->blocking || req->partial)) {
      // If we can return data without waiting, and the connection is
      // non-blocking (or using curl_fetch_stream()), do so.
      // This ensures that bytes we already received get flushed
      // to the target buffer before a connection error.
      con->incomplete = req->has_more || req->size;
      return total_size;
  }

  while((req_size > total_size) && req->has_more) {
    int numfds;
    massert(curl_multi_wait(req->manager, NULL, 0, con->blocking ? 1000 : 10, &numfds));

    fetchdata(req);
    total_size += pop((char*)target + total_size, (req_size-total_size), req);

    //return less than requested data for non-blocking connections, or curl_fetch_stream()
    if(!con->blocking || req->partial)
      break;
  }
  con->incomplete = req->has_more || req->size;
  return total_size;
}

SEXP reflist_remove(SEXP x, SEXP target){
  if(!Rf_isPairList(x))
    Rf_error("Not a LISTSXP");

  //drop head
  if(x != R_NilValue && CAR(x) == target)
    return(CDR(x));
  SEXP prev = x;
  SEXP current = CDR(x);

  //check inner nodes
  while(current != R_NilValue){
    if(CAR(current) == target){
      SETCDR(prev, CDR(current));
      return(x);
    }
    prev = current;
    current = CDR(current);
  }
  Rf_error("Object not found in reflist!");
}

static void reset(Rconnection con) {
  request *req = (request*) con->private;
  curl_multi_remove_handle(req->manager, req->handle);
  curl_easy_setopt(req->handle, CURLOPT_WRITEFUNCTION, NULL);
  curl_easy_setopt(req->handle, CURLOPT_WRITEDATA, NULL);
  curl_easy_setopt(req->handle, CURLOPT_FAILONERROR, 0L);
  req->ref->locked = 0;
  con->isopen = FALSE;
  con->text = TRUE;
  con->incomplete = FALSE;
  strcpy(con->mode, "r");
}

void reset_errbuf(reference *ref){
  memset(ref->errbuf, 0, CURL_ERROR_SIZE);
}

static void set_url(CURLU *h, const char *str, int default_scheme){
  int flags = CURLU_NON_SUPPORT_SCHEME | CURLU_URLENCODE | (default_scheme * CURLU_DEFAULT_SCHEME);
  fail_if(curl_url_set(h, CURLUPART_URL, str, flags));
}

struct curl_slist* vec_to_slist(SEXP vec){
  if(!Rf_isString(vec))
    Rf_error("vec is not a character vector");
  struct curl_slist *slist = NULL;
  for(int i = 0; i < Rf_length(vec); i++){
    slist = curl_slist_append(slist, CHAR(STRING_ELT(vec, i)));
  }
  return slist;
}