/* Return a pair of mutually connected sockets in sv[0] and sv[1] */
int
socketpair(
int af,
int type,
int protocol,
int sv[]
){
struct usock *up0, *up1;
if(sv == NULL){
errno = EFAULT;
return -1;
}
if(af != AF_LOCAL){
errno = EAFNOSUPPORT;
return -1;
}
if(type != SOCK_STREAM && type != SOCK_DGRAM){
errno = ESOCKTNOSUPPORT;
return -1;
}
if((sv[0] = socket(af,type,protocol)) == -1)
return -1;
if((sv[1] = socket(af,type,protocol)) == -1){
close_s(sv[0]);
return -1;
}
up0 = itop(sv[0]);
up1 = itop(sv[1]);
up0->cb.local->peer = up1;
up1->cb.local->peer = up0;
return sv[1];
}
/* Wait for a connection. Valid only for connection-oriented sockets. */
int
accept(
int s, /* Socket index */
struct sockaddr *peername, /* Peer name */
int *peernamelen /* Length of peer name */
){
int i;
register struct usock *up;
struct socklink *sp;
if((up = itop(s)) == NULL){
errno = EBADF;
return -1;
}
if(up->cb.p == NULL){
errno = EOPNOTSUPP;
return -1;
}
sp = up->sp;
/* Fail if accept flag isn't set */
if(sp->accept == FALSE){
errno = EOPNOTSUPP;
return -1;
}
/* Wait for the state-change upcall routine to signal us */
while(up->cb.p != NULL && up->rdysock == -1){
if(up->noblock){
errno = EWOULDBLOCK;
return -1;
} else if((errno = kwait(up)) != 0){
return -1;
}
}
if(up->cb.p == NULL){
/* Blown away */
errno = EBADF;
return -1;
}
i = up->rdysock;
up->rdysock = -1;
up = itop(i);
if(peername != NULL && peernamelen != NULL){
*peernamelen = min(up->peernamelen,*peernamelen);
memcpy(peername,up->peername,*peernamelen);
}
return i;
}
/* Return local name passed in an earlier bind() call */
int
getsockname(
int s, /* Socket index */
struct sockaddr *name, /* Place to stash name */
int *namelen /* Length of same */
){
register struct usock *up;
if((up = itop(s)) == NULL){
errno = EBADF;
return -1;
}
if(name == NULL || namelen == (int *)NULL){
errno = EFAULT;
return -1;
}
if(up->name == NULL){
/* Not bound yet */
*namelen = 0;
return 0;
}
if(up->name != NULL){
*namelen = min(*namelen,up->namelen);
memcpy(name,up->name,*namelen);
}
return 0;
}
/* Close down a socket three ways. Type 0 means "no more receives"; this
* replaces the incoming data upcall with a routine that discards further
* data. Type 1 means "no more sends", and obviously corresponds to sending
* a TCP FIN. Type 2 means "no more receives or sends". This I interpret
* as "abort the connection".
*/
int
shutdown(
int s, /* Socket index */
int how /* (see above) */
){
register struct usock *up;
struct socklink *sp;
if((up = itop(s)) == NULL){
errno = EBADF;
return -1;
}
if(up->cb.p == NULL){
errno = ENOTCONN;
return -1;
}
sp = up->sp;
/* Just close the socket if special shutdown routine not present */
if(sp->shut == NULL){
close_s(s);
} else if((*sp->shut)(up,how) == -1){
return -1;
}
ksignal(up,0);
return 0;
}
/* Close a socket, freeing it for reuse. Try to do a graceful close on a
* TCP socket, if possible
*/
int
close_s(
int s /* Socket index */
){
register struct usock *up;
struct socklink *sp;
if((up = itop(s)) == NULL){
errno = EBADF;
return -1;
}
if(--up->refcnt > 0)
return 0; /* Others are still using it */
/* Call proto-specific close routine if there is one */
if((sp = up->sp) != NULL && sp->close != NULL)
(*sp->close)(up);
free(up->name);
free(up->peername);
ksignal(up,0); /* Wake up anybody doing an accept() or recv() */
Usock[_fd_seq(up->index)] = NULL;
free(up);
return 0;
}
/* TCP transmit upcall routine */
static void
s_ttcall(struct tcb *tcb,int32 cnt)
{
/* Wake up anybody waiting to send data, and let them run */
ksignal(itop(tcb->user),1);
kwait(NULL);
}
/* Return length of protocol queue, either send or receive. */
int
socklen(
int s, /* Socket index */
int rtx /* 0 = receive queue, 1 = transmit queue */
){
register struct usock *up;
struct socklink *sp;
int len = -1;
if((up = itop(s)) == NULL){
errno = EBADF;
return -1;
}
if(up->cb.p == NULL){
errno = ENOTCONN;
return -1;
}
if(rtx < 0 || rtx > 1){
errno = EINVAL;
return -1;
}
sp = up->sp;
/* Fail if qlen routine isn't present */
if(sp->qlen == NULL || (len = (*sp->qlen)(up,rtx)) == -1){
errno = EOPNOTSUPP;
return -1;
}
return len;
}
static void fixtypemappings(Stab *st)
{
size_t i;
Type *t, *old;
/*
* merge duplicate definitions.
* This allows us to compare named types by id, instead
* of doing a deep walk through the type. This ability is
* depended on when we do type inference.
*/
for (i = 0; i < ntypefixdest; i++) {
t = htget(tidmap, itop(typefixid[i]));
if (!t)
die("Unable to find type for id %zd\n", typefixid[i]);
*typefixdest[i] = t;
}
for (i = 0; i < ntypefixdest; i++) {
old = *typefixdest[i];
if (old->type == Tyname || old->type == Tygeneric) {
t = htget(tydedup, old);
if (!t) {
t = old;
htput(tydedup, old, old);
}
*typefixdest[i] = t;
}
}
/* check for duplicate type definitions */
for (i = 0; i < ntypefixdest; i++) {
t = htget(tidmap, itop(typefixid[i]));
if ((t->type != Tyname && t->type != Tygeneric) || t->issynth)
continue;
old = htget(tydedup, t);
if (old && !tyeq(t, old) && !isspecialization(t, old))
lfatal(t->loc, "Duplicate definition of type %s on %s:%d", tystr(old), file->file.files[old->loc.file], old->loc.line);
}
for (i = 0; i < ntypefixdest; i++)
lfree(&typefixdest, &ntypefixdest);
lfree(&typefixid, &ntypefixid);
}
/* Return end-of-line convention for socket */
char *
eolseq(int s)
{
struct usock *up;
if((up = itop(s)) == NULL){
errno = EBADF;
return NULL;
}
return up->sp->eol;
}
/* Set Internet type-of-service to be used */
int
settos(int s, int tos)
{
struct usock *up;
if((up = itop(s)) == NULL){
errno = EBADF;
return -1;
}
up->tos = tos;
return 0;
}
static void rdtype(FILE *fd, Type **dest)
{
uintptr_t tid;
tid = rdint(fd);
if (tid & Builtinmask) {
*dest = mktype(Zloc, tid & ~Builtinmask);
} else {
lappend(&typefixdest, &ntypefixdest, dest);
lappend(&typefixid, &ntypefixid, itop(tid));
}
}
/* Increment reference count for specified socket */
int
usesock(int s)
{
struct usock *up;
if((up = itop(s)) == NULL){
errno = EBADF;
return -1;
}
up->refcnt++;
return 0;
}
void MinMax (IMAGE a, IMAGE b, int *rmax,
int *cmax, int *rmin, int *cmin)
{
int x=0, y=0;
/* (0,0) index is which pixel? */
y = jtop (a, 0);
x = jtop (b, 0);
if (x < y) *cmin = x; else *cmin = y;
y = itop (a, 0);
x = itop (b, 0);
if (x < y) *rmin = x; else *rmin = y;
/* Now max indices */
x = itop (a, a->info->nr);
y = itop (b, b->info->nr);
if (x > y) *rmax = x; else *rmax = y;
x = jtop (a, a->info->nc);
y = jtop (b, b->info->nc);
if (x>y) *cmax = x; else *cmax = y;
}
static void rdtrait(FILE *fd, Trait **dest, Type *ty)
{
uintptr_t tid;
tid = rdint(fd);
if (tid & Builtinmask) {
if (dest)
*dest = traittab[tid & ~Builtinmask];
if (ty)
settrait(ty, traittab[tid & ~Builtinmask]);
} else {
lappend(&traitfixdest, &ntraitfixdest, dest);
lappend(&traitfixtype, &ntraitfixtype, ty);
lappend(&traitfixid, &ntraitfixid, itop(tid));
}
}
/* Change owner of socket, return previous owner */
struct proc *
sockowner(
int s, /* Socket index */
struct proc *newowner /* Process table address of new owner */
){
register struct usock *up;
struct proc *pp;
if((up = itop(s)) == NULL){
errno = EBADF;
return NULL;
}
pp = up->owner;
if(newowner != NULL)
up->owner = newowner;
return pp;
}
Trait *traitunpickle(FILE *fd)
{
Trait *tr;
size_t i, n;
intptr_t uid;
/* create an empty trait */
tr = mktrait(Zloc, NULL, NULL, NULL, 0, NULL, 0, 0);
uid = rdint(fd);
tr->ishidden = rdbool(fd);
tr->name = unpickle(fd);
tr->param = tyunpickle(fd);
n = rdint(fd);
for (i = 0; i < n; i++)
lappend(&tr->memb, &tr->nmemb, rdsym(fd, tr));
n = rdint(fd);
for (i = 0; i < n; i++)
lappend(&tr->funcs, &tr->nfuncs, rdsym(fd, tr));
htput(trmap, itop(uid), tr);
return tr;
}
/* Force retransmission. Valid only for connection-oriented sockets. */
int
sockkick(
int s /* Socket index */
){
register struct usock *up;
struct socklink *sp;
if((up = itop(s)) == NULL){
errno = EBADF;
return -1;
}
sp = up->sp;
/* Fail if kick routine isn't present */
if(sp->kick == NULL){
errno = EOPNOTSUPP;
return -1;
}
if((*sp->kick)(up) == -1)
return -1;
return 0;
}
/* Attach a local address/port to a socket. If not issued before a connect
* or listen, will be issued automatically
*/
int
bind(
int s, /* Socket index */
struct sockaddr *name, /* Local name */
int namelen /* Length of name */
){
register struct usock *up;
struct socklink *sp;
if((up = itop(s)) == NULL){
errno = EBADF;
return -1;
}
if(name == NULL){
errno = EFAULT;
return -1;
}
if(up->name != NULL){
/* Bind has already been issued */
errno = EINVAL;
return -1;
}
sp = up->sp;
if(sp->check != NULL && (*sp->check)(name,namelen) == -1){
/* Incorrect length or family for chosen protocol */
errno = EAFNOSUPPORT;
return -1;
}
/* Stash name in an allocated block */
up->namelen = namelen;
up->name = mallocw(namelen);
memcpy(up->name,name,namelen);
/* a bind routine is optional - don't fail if it isn't present */
if(sp->bind != NULL && (*sp->bind)(up) == -1){
errno = EOPNOTSUPP;
return -1;
}
return 0;
}
/* Low level send routine; user supplies mbuf for transmission. More
* efficient than send() or sendto(), the higher level interfaces.
* The "to" and "tolen" parameters are ignored on connection-oriented
* sockets.
*
* In case of error, bp is freed so the caller doesn't have to worry about it.
*/
int
send_mbuf(
int s, /* Socket index */
struct mbuf **bpp, /* Buffer to send */
int flags, /* not currently used */
struct sockaddr *to, /* Destination, only for datagrams */
int tolen /* Length of destination */
){
register struct usock *up;
int cnt;
struct socklink *sp;
if((up = itop(s)) == NULL){
free_p(bpp);
errno = EBADF;
return -1;
}
sp = up->sp;
/* Fail if send routine isn't present (shouldn't happen) */
if(sp->send == NULL){
free_p(bpp);
return -1;
}
/* If remote address is supplied, check it */
if(to != NULL && (sp->check != NULL)
&& (*sp->check)(to,tolen) == -1){
free_p(bpp);
errno = EAFNOSUPPORT;
return -1;
}
/* The proto send routine is expected to free the buffer
* we pass it even if the send fails
*/
if((cnt = (*sp->send)(up,bpp,to)) == -1){
errno = EOPNOTSUPP;
return -1;
}
return cnt;
}
/* Low-level receive routine. Passes mbuf back to user; more efficient than
* higher-level functions recv() and recvfrom(). Datagram sockets ignore
* the len parameter.
*/
int
recv_mbuf(
int s, /* Socket index */
struct mbuf **bpp, /* Place to stash receive buffer */
int flags, /* Unused; will control out-of-band data, etc */
struct sockaddr *from, /* Peer address (only for datagrams) */
int *fromlen /* Length of peer address */
){
register struct usock *up;
struct socklink *sp;
if((up = itop(s)) == NULL){
errno = EBADF;
return -1;
}
sp = up->sp;
/* Fail if recv routine isn't present */
if(sp->recv == NULL){
errno = EOPNOTSUPP;
return -1;
}
return (*sp->recv)(up,bpp,from,fromlen);
}
/* Initiate active open. For datagram sockets, merely bind the remote address. */
int
connect(
int s, /* Socket index */
struct sockaddr *peername, /* Peer name */
int peernamelen /* Length of peer name */
){
register struct usock *up;
struct socklink *sp;
if((up = itop(s)) == NULL){
errno = EBADF;
return -1;
}
if(peername == NULL){
/* Connect must specify a remote address */
errno = EFAULT;
return -1;
}
sp = up->sp;
/* Check name format, if checking routine is available */
if(sp->check != NULL && (*sp->check)(peername,peernamelen) == -1){
errno = EAFNOSUPPORT;
return -1;
}
if(up->peername != NULL)
free(up->peername);
up->peername = mallocw(peernamelen);
memcpy(up->peername,peername,peernamelen);
up->peernamelen = peernamelen;
/* a connect routine is optional - don't fail if it isn't present */
if(sp->connect != NULL && (*sp->connect)(up) == -1){
return -1;
}
return 0;
}
/* Get remote name, returning result of earlier connect() call. */
int
getpeername(
int s, /* Socket index */
struct sockaddr *peername, /* Place to stash name */
int *peernamelen /* Length of same */
){
register struct usock *up;
if((up = itop(s)) == NULL){
errno = EBADF;
return -1;
}
if(up->peername == NULL){
errno = ENOTCONN;
return -1;
}
if(peername == NULL || peernamelen == (int *)NULL){
errno = EFAULT;
return -1;
}
*peernamelen = min(*peernamelen,up->peernamelen);
memcpy(peername,up->peername,*peernamelen);
return 0;
}
static void fixtraitmappings(Stab *st)
{
size_t i;
Trait *t;
/*
* merge duplicate definitions.
* This allows us to compare named types by id, instead
* of doing a deep walk through the type. This ability is
* depended on when we do type inference.
*/
for (i = 0; i < ntraitfixdest; i++) {
t = htget(trmap, itop(traitfixid[i]));
if (!t)
die("Unable to find trait for id %zd\n", traitfixid[i]);
if (traitfixdest[i])
*traitfixdest[i] = t;
if (traitfixtype[i])
settrait(traitfixtype[i], t);
}
lfree(&traitfixdest, &ntraitfixdest);
lfree(&traitfixid, &ntraitfixid);
}
/* Post a listen on a socket */
int
listen(
int s, /* Socket index */
int backlog /* 0 for a single connection, !=0 for multiple connections */
){
register struct usock *up;
struct socklink *sp;
if((up = itop(s)) == NULL){
errno = EBADF;
return -1;
}
if(up->cb.p != NULL){
errno = EISCONN;
return -1;
}
sp = up->sp;
/* Fail if listen routine isn't present */
if(sp->listen == NULL || (*sp->listen)(up,backlog) == -1){
errno = EOPNOTSUPP;
return -1;
}
return 0;
}
s_ttcall(struct tcb *tcb,int32 cnt)
{
/* Wake up anybody waiting to send data, and let them run */
ksignal(itop(tcb->user),1);
kwait(NULL);
}
/* TCP state change upcall routine */
static void
s_tscall(struct tcb *tcb,int old,int new)
{
int s,ns;
struct usock *up,*nup,*oup;
union sp sp;
s = tcb->user;
oup = up = itop(s);
switch(new){
case TCP_CLOSED:
/* Clean up. If the user has already closed the socket,
* then up will be null (s was set to -1 by the close routine).
* If not, then this is an abnormal close (e.g., a reset)
* and clearing out the pointer in the socket structure will
* prevent any further operations on what will be a freed
* control block. Also wake up anybody waiting on events
* related to this tcb so they will notice it disappearing.
*/
if(up != NULL){
up->cb.tcb = NULL;
up->errcodes[0] = tcb->reason;
up->errcodes[1] = tcb->type;
/* Usefile format:
* U<pkgname>
* T<pickled-type>
* R<picled-trait>
* I<pickled-impl>
* D<picled-decl>
* G<pickled-decl><pickled-initializer>
*/
int loaduse(char *path, FILE *f, Stab *st, Vis vis)
{
intptr_t tid;
size_t i;
int v;
char *pkg;
Node *dcl, *impl, *init;
Stab *s;
Type *ty;
Trait *tr;
char *lib;
int c;
pushstab(file->file.globls);
if (!tydedup)
tydedup = mkht(tyhash, tyeq);
if (fgetc(f) != 'U')
return 0;
v = rdint(f);
if (v != Abiversion) {
fprintf(stderr, "%s: abi version %d, expected %d\n", path, v, Abiversion);
return 0;
}
pkg = rdstr(f);
/* if the package names match up, or the usefile has no declared
* package, then we simply add to the current stab. Otherwise,
* we add a new stab under the current one */
if (st->name) {
if (pkg && !strcmp(pkg, st->name)) {
s = st;
} else {
s = findstab(st, pkg);
}
} else {
if (pkg) {
s = findstab(st, pkg);
} else {
s = st;
}
}
if (!streq(st->name, pkg))
vis = Visintern;
if (!s) {
printf("could not find matching package for merge: %s in %s\n", st->name, path);
exit(1);
}
tidmap = mkht(ptrhash, ptreq);
trmap = mkht(ptrhash, ptreq);
if (!initmap)
initmap = mkht(namehash, nameeq);
/* builtin traits */
for (i = 0; i < Ntraits; i++)
htput(trmap, itop(i), traittab[i]);
while ((c = fgetc(f)) != EOF) {
switch(c) {
case 'L':
lib = rdstr(f);
for (i = 0; i < file->file.nlibdeps; i++)
if (!strcmp(file->file.libdeps[i], lib))
/* break out of both loop and switch */
goto foundlib;
lappend(&file->file.libdeps, &file->file.nlibdeps, lib);
foundlib:
break;
case 'X':
lib = rdstr(f);
for (i = 0; i < file->file.nextlibs; i++)
if (!strcmp(file->file.extlibs[i], lib))
/* break out of both loop and switch */
goto foundextlib;
lappend(&file->file.extlibs, &file->file.nextlibs, lib);
foundextlib:
break;
case 'F':
lappend(&file->file.files, &file->file.nfiles, rdstr(f));
break;
case 'G':
case 'D':
dcl = rdsym(f, NULL);
dcl->decl.vis = vis;
dcl->decl.isglobl = 1;
putdcl(s, dcl);
break;
case 'S':
init = unpickle(f);
if (!hthas(initmap, init)) {
htput(initmap, init, init);
lappend(&file->file.init, &file->file.ninit, init);
}
break;
case 'R':
tr = traitunpickle(f);
tr->vis = vis;
puttrait(s, tr->name, tr);
for (i = 0; i < tr->nfuncs; i++)
putdcl(s, tr->funcs[i]);
break;
case 'T':
tid = rdint(f);
ty = tyunpickle(f);
if(!ty->ishidden)
ty->vis = vis;
htput(tidmap, itop(tid), ty);
/* fix up types */
if (ty->type == Tyname || ty->type == Tygeneric) {
if (ty->issynth)
break;
if (!streq(s->name, ty->name->name.ns))
ty->ishidden = 1;
if (!gettype(s, ty->name) && !ty->ishidden)
puttype(s, ty->name, ty);
} else if (ty->type == Tyunion) {
for (i = 0; i < ty->nmemb; i++)
if (!getucon(s, ty->udecls[i]->name) && !ty->udecls[i]->synth)
putucon(s, ty->udecls[i]);
}
break;
case 'I':
impl = unpickle(f);
putimpl(s, impl);
/* specialized declarations always go into the global stab */
for (i = 0; i < impl->impl.ndecls; i++)
putdcl(file->file.globls, impl->impl.decls[i]);
break;
case EOF:
break;
}
}
fixtypemappings(s);
fixtraitmappings(s);
htfree(tidmap);
popstab();
return 1;
}
SEXP RS_connect(SEXP sHost, SEXP sPort, SEXP useTLS, SEXP sProxyTarget, SEXP sProxyWait) {
int port = asInteger(sPort), use_tls = (asInteger(useTLS) == 1), px_get_slot = (asInteger(sProxyWait) == 0);
const char *host;
char idstr[32];
rsconn_t *c;
SEXP res, caps = R_NilValue;
if (port < 0 || port > 65534)
Rf_error("Invalid port number");
#ifdef WIN32
if (!port)
Rf_error("unix sockets are not supported in Windows");
#endif
#ifndef USE_TLS
if (use_tls)
Rf_error("TLS is not supported in this build - recompile with OpenSSL");
#endif
if (sHost == R_NilValue && !port)
Rf_error("socket name must be specified in socket mode");
if (sHost == R_NilValue)
host = "127.0.0.1";
else {
if (TYPEOF(sHost) != STRSXP || LENGTH(sHost) != 1)
Rf_error("host must be a character vector of length one");
host = R2UTF8(sHost);
}
c = rsc_connect(host, port);
if (!c)
Rf_error("cannot connect to %s:%d", host, port);
#ifdef USE_TLS
if (use_tls && tls_upgrade(c) != 1) {
rsc_close(c);
Rf_error("TLS handshake failed");
}
#endif
if (rsc_read(c, idstr, 32) != 32) {
rsc_close(c);
Rf_error("Handshake failed - ID string not received");
}
if (!memcmp(idstr, "RSpx", 4) && !memcmp(idstr + 8, "QAP1", 4)) { /* RSpx proxy protocol */
const char *proxy_target;
struct phdr hdr;
if (TYPEOF(sProxyTarget) != STRSXP || LENGTH(sProxyTarget) < 1) {
rsc_close(c);
Rf_error("Connected to a non-transparent proxy, but no proxy target was specified");
}
/* send CMD_PROXY_TARGET and re-fetch ID string */
proxy_target = CHAR(STRING_ELT(sProxyTarget, 0));
hdr.cmd = itop(CMD_PROXY_TARGET);
hdr.len = itop(strlen(proxy_target) + 1);
hdr.dof = 0;
hdr.res = 0;
rsc_write(c, &hdr, sizeof(hdr));
rsc_write(c, proxy_target, strlen(proxy_target) + 1);
if (px_get_slot) { /* send CMD_PROXY_GET_SLOT as well if requested */
hdr.cmd = itop(CMD_PROXY_GET_SLOT);
hdr.len = 0;
rsc_write(c, &hdr, sizeof(hdr));
}
rsc_flush(c);
if (rsc_read(c, idstr, 32) != 32) {
rsc_close(c);
Rf_error("Handshake failed - ID string not received (after CMD_PROXY_TARGET)");
}
}
/* OC mode */
if (((const int*)idstr)[0] == itop(CMD_OCinit)) {
int sb_len;
struct phdr *hdr = (struct phdr *) idstr;
hdr->len = itop(hdr->len);
if (hdr->res || hdr->dof || hdr->len > sizeof(slurp_buffer) || hdr->len < 16) {
rsc_close(c);
Rf_error("Handshake failed - invalid RsOC OCinit message");
}
sb_len = 32 - sizeof(struct phdr);
memcpy(slurp_buffer, idstr + sizeof(struct phdr), sb_len);
if (rsc_read(c, slurp_buffer + sb_len, hdr->len - sb_len) != hdr->len - sb_len) {
rsc_close(c);
Rf_error("Handshake failed - truncated RsOC OCinit message");
} else {
unsigned int *ibuf = (unsigned int*) slurp_buffer;
int par_type = PAR_TYPE(*ibuf);
int is_large = (par_type & DT_LARGE) ? 1 : 0;
if (is_large) par_type ^= DT_LARGE;
if (par_type != DT_SEXP) {
rsc_close(c);
Rf_error("Handshake failed - invalid payload in OCinit message");
}
ibuf += is_large + 1;
caps = QAP_decode(&ibuf);
if (caps != R_NilValue)
PROTECT(caps);
}
} else {
if (memcmp(idstr, "Rsrv", 4) || memcmp(idstr + 8, "QAP1", 4)) {
rsc_close(c);
Rf_error("Handshake failed - unknown protocol");
}
/* supported range 0100 .. 0103 */
if (memcmp(idstr + 4, "0100", 4) < 0 || memcmp(idstr + 4, "0103", 4) > 0) {
rsc_close(c);
Rf_error("Handshake failed - server protocol version too high");
}
}
res = PROTECT(R_MakeExternalPtr(c, R_NilValue, R_NilValue));
setAttrib(res, R_ClassSymbol, mkString("RserveConnection"));
R_RegisterCFinalizer(res, rsconn_fin);
if (caps != R_NilValue) {
setAttrib(res, install("capabilities"), caps);
UNPROTECT(1);
}
UNPROTECT(1);
return res;
}