SUMMARY:
I'm proposing that R assert that 'connection' options have not changed
since first created such that R will produce the following error:
> fh <- file("a.txt", open = "w+")
> cat("hello\n", file = fh)
> close(fh)
> fh2 <- file("b.txt", open = "w+")
> cat("world\n", file = fh2)
> cat("hello again\n", file = fh)
Error in cat("hello again\n", file = fh) :
invalid connection (non-existing 'conn_id')
Note that, currently in R, the latter silently writes to 'b.txt' - not
'a.txt' (for more details, see
https://github.com/HenrikBengtsson/Wishlist-for-R/issues/81).
BACKGROUND:
In R, connections are indexed by their (zero-based) row indices in the
table of available connections. For example,
> fh <- file("a.txt", open = "w")
> showConnections(all = TRUE)
description class mode text isopen can read can write
0 "stdin" "terminal" "r" "text" "opened" "yes" "no"
1 "stdout" "terminal" "w" "text" "opened" "no" "yes"
2 "stderr" "terminal" "w" "text" "opened" "no" "yes"
3 "a.txt" "file" "w" "text" "opened" "no" "yes"
> con <- getConnection(3)
> identical(con, fh)
[1] TRUE
ISSUE:
The problem with the current design/implementation where connections
are referred to by their index (only), is that
(i) the table of connections changes over time and
(ii) connection indices are recycled.
Because a `connection` object holds the connection row index, it means
that *the actual underlying connection that a `connection` object
refers to may change over its lifetime*.
SUGGESTION:
Make use of the 'Rconn' struct field 'id', which is unique, to assert
that the 'connection' object used is referring to the
original/expected connection. The 'id' field is available via
attribute 'conn_id' part of a 'connection' object.
PATCH:
See attached 'connection.patch' file (or
https://github.com/HenrikBengtsson/Wishlist-for-R/issues/81#issuecomment-434210222).
The patch introduces a new SEXP R_GetConnection2(SEXP sConn) function,
which looks up a connection by its index *and* the 'id' field. This
function is backward compatible with R_GetConnection(), which looks up
a connection by its index (only). In addition, R_GetConnection2() also
accepts 'sConn' of type integer, which the looks up the connection
similar to how the internal getConnection() function does it.
Comment: The patch is just one of many alternatives. Hopefully, it
helps clarify what I'm suggesting. It passes 'make check' and I've
tested it on a few packages of mine that make heavy use of different
types of connections.
In addition to "overridden" connections, the patch protects against
invalid 'connection':s that have been serialized, e.g.
> fh2 <- file("b.txt", open = "w+")
> saveRDS(fh2, file = "fh2.rds")
> fh3 <- readRDS("fh2.rds")
> attr(fh2, "conn_id")
<pointer: 0x78>
> attr(fh3, "conn_id")
<pointer: (nil)> #<== NIL because external pointer was lost when serialized
> isOpen(fh2)
[1] TRUE
> isOpen(fh3)
Error in isOpen(fh3) : invalid connection ('conn_id' is NULL)
This is useful, when for instance 'connection':s are (incorrectly)
passed to background R sessions (e.g. PSOCK cluster nodes).
SEE ALSO:
* More details of the above are scribbled down on
https://github.com/HenrikBengtsson/Wishlist-for-R/issues/81
* R-devel post 'closeAllConnections() can really mess things up',
2016-10-30, https://stat.ethz.ch/pipermail/r-devel/2016-October/073331.html
All the best,
Henrik
Index: src/include/R_ext/Connections.h
===================================================================
--- src/include/R_ext/Connections.h (revision 75521)
+++ src/include/R_ext/Connections.h (working copy)
@@ -92,6 +92,7 @@
size_t R_ReadConnection(Rconnection con, void *buf, size_t n);
size_t R_WriteConnection(Rconnection con, void *buf, size_t n);
Rconnection R_GetConnection(SEXP sConn); // added in R 3.3.0
+Rconnection R_GetConnection2(SEXP sConn); // added in R 3.6.0
#ifdef __cplusplus
}
Index: src/library/tools/src/gramRd.c
===================================================================
--- src/library/tools/src/gramRd.c (revision 75521)
+++ src/library/tools/src/gramRd.c (working copy)
@@ -4435,9 +4435,11 @@
PushState();
- ifile = asInteger(CAR(args)); args = CDR(args);
+ ifile = asInteger(CAR(args));
- con = getConnection(ifile);
+ con = R_GetConnection2(CAR(args));
+ args = CDR(args);
+
wasopen = con->isopen;
source = CAR(args); args = CDR(args);
/* encoding is unused */
Index: src/library/utils/src/io.c
===================================================================
--- src/library/utils/src/io.c (revision 75521)
+++ src/library/utils/src/io.c (working copy)
@@ -352,7 +352,7 @@
error(_("invalid quote symbol set"));
i = asInteger(file);
- data.con = getConnection(i);
+ data.con = R_GetConnection2(file);
if(i == 0) {
data.ttyflag = 1;
} else {
@@ -852,7 +852,7 @@
data.skipNul = skipNul;
i = asInteger(file);
- data.con = getConnection(i);
+ data.con = R_GetConnection2(file);
data.ttyflag = (i == 0);
data.wasopen = data.con->isopen;
if(!data.wasopen) {
@@ -1076,7 +1076,8 @@
/* this is going to be a connection open or openable for writing */
if(!inherits(CAR(args), "connection"))
error(_("'file' is not a connection"));
- con = getConnection(asInteger(CAR(args))); args = CDR(args);
+ con = R_GetConnection2(CAR(args));
+ args = CDR(args);
if(!con->canwrite)
error(_("cannot write to this connection"));
wasopen = con->isopen;
Index: src/main/builtin.c
===================================================================
--- src/main/builtin.c (revision 75521)
+++ src/main/builtin.c (working copy)
@@ -565,7 +565,7 @@
file = CAR(args);
ifile = asInteger(file);
- con = getConnection(ifile);
+ con = R_GetConnection2(file);
if(!con->canwrite) /* if it is not open, we may not know yet */
error(_("cannot write to this connection"));
args = CDR(args);
Index: src/main/connections.c
===================================================================
--- src/main/connections.c (revision 75521)
+++ src/main/connections.c (working copy)
@@ -178,6 +178,21 @@
}
+Rconnection getConnection2(int n, void *id)
+{
+ Rconnection con = NULL;
+
+ if(n < 0 || n >= NCONNECTIONS || n == NA_INTEGER ||
+ !(con = Connections[n]))
+ error(_("invalid connection"));
+ if (!id)
+ error(_("invalid connection ('conn_id' is NULL)"));
+ else if (con->id != id)
+ error(_("invalid connection (non-existing 'conn_id')"));
+
+ return con;
+}
+
attribute_hidden
int getActiveSink(int n)
{
@@ -2894,7 +2909,7 @@
checkArity(op, args);
if(!inherits(CAR(args), "rawConnection"))
error(_("'con' is not a rawConnection"));
- con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
if(!con->canwrite)
error(_("'con' is not an output rawConnection"));
this = con->private;
@@ -3318,7 +3333,7 @@
checkArity(op, args);
if(!inherits(CAR(args), "textConnection"))
error(_("'con' is not a textConnection"));
- con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
if(!con->canwrite)
error(_("'con' is not an output textConnection"));
this = con->private;
@@ -3462,7 +3477,7 @@
if(!inherits(CAR(args), "connection"))
error(_("'con' is not a connection"));
i = asInteger(CAR(args));
- con = getConnection(i);
+ con = R_GetConnection2(CAR(args));
if(i < 3) error(_("cannot open standard connections"));
if(con->isopen) {
warning(_("connection is already open"));
@@ -3491,7 +3506,7 @@
int rw, res;
checkArity(op, args);
- con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
rw = asInteger(CADR(args));
res = con->isopen != FALSE;
switch(rw) {
@@ -3510,7 +3525,7 @@
checkArity(op, args);
if(!inherits(CAR(args), "connection"))
error(_("'con' is not a connection"));
- con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
return ScalarLogical(con->incomplete != FALSE);
}
@@ -3521,7 +3536,7 @@
checkArity(op, args);
if(!inherits(CAR(args), "connection"))
error(_("'con' is not a connection"));
- con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
return ScalarLogical(con->canseek != FALSE);
}
@@ -3611,7 +3626,7 @@
error(_("cannot close 'output' sink connection"));
if(i == R_ErrorCon)
error(_("cannot close 'message' sink connection"));
- Rconnection con = getConnection(i);
+ Rconnection con = R_GetConnection2(CAR(args));
int status = con_close1(con);
free(Connections[i]);
Connections[i] = NULL;
@@ -3634,7 +3649,7 @@
checkArity(op, args);
if(!inherits(CAR(args), "connection"))
error(_("'con' is not a connection"));
- con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
if(!con->isopen) error(_("connection is not open"));
where = asReal(CADR(args));
origin = asInteger(CADDR(args));
@@ -3657,7 +3672,7 @@
checkArity(op, args);
if(!inherits(CAR(args), "connection"))
error(_("'con' is not a connection"));
- con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
con->truncate(con);
return R_NilValue;
}
@@ -3669,7 +3684,7 @@
checkArity(op, args);
if(!inherits(CAR(args), "connection"))
error(_("'con' is not a connection"));
- con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
if(con->canwrite) con->fflush(con);
return R_NilValue;
}
@@ -3795,7 +3810,8 @@
checkArity(op, args);
if(!inherits(CAR(args), "connection"))
error(_("'con' is not a connection"));
- con = getConnection(asInteger(CAR(args))); args = CDR(args);
+ con = R_GetConnection2(CAR(args));
+ args = CDR(args);
n = asVecSize(CAR(args)); args = CDR(args);
if(n == -999)
error(_("invalid '%s' argument"), "n");
@@ -3923,7 +3939,7 @@
if(!inherits(CADR(args), "connection"))
error(_("'con' is not a connection"));
con_num = asInteger(CADR(args));
- con = getConnection(con_num);
+ con = R_GetConnection2(CADR(args));
sep = CADDR(args);
if(!isString(sep)) error(_("invalid '%s' argument"), "sep");
useBytes = asLogical(CADDDR(args));
@@ -4076,7 +4092,7 @@
bytes = RAW(CAR(args));
nbytes = XLENGTH(CAR(args));
} else {
- con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
if(con->text) error(_("can only read from a binary connection"));
}
@@ -4335,7 +4351,7 @@
if(TYPEOF(CADR(args)) == RAWSXP) {
isRaw = TRUE;
} else {
- con = getConnection(asInteger(CADR(args)));
+ con = R_GetConnection2(CADR(args));
if(con->text) error(_("can only write to a binary connection"));
wasopen = con->isopen;
if(!con->canwrite) error(_("cannot write to this connection"));
@@ -4676,7 +4692,7 @@
bytes = RAW(CAR(args));
nbytes = LENGTH(CAR(args));
} else {
- con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
if(!con->canread)
error(_("cannot read from this connection"));
}
@@ -4756,7 +4772,7 @@
if(TYPEOF(CADR(args)) == RAWSXP) {
isRaw = TRUE;
} else {
- con = getConnection(asInteger(CADR(args)));
+ con = R_GetConnection2(CADR(args));
if(!con->canwrite)
error(_("cannot write to this connection"));
wasopen = con->isopen;
@@ -4955,7 +4971,7 @@
stext = CAR(args);
if(!isString(stext))
error(_("invalid '%s' argument"), "data");
- con = getConnection(asInteger(CADR(args)));
+ con = R_GetConnection2(CADR(args));
newLine = asLogical(CADDR(args));
if(newLine == NA_LOGICAL)
error(_("invalid '%s' argument"), "newLine");
@@ -4994,7 +5010,7 @@
Rconnection con = NULL;
checkArity(op, args);
- con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
return ScalarInteger(con->nPushBack);
}
@@ -5004,7 +5020,7 @@
Rconnection con = NULL;
checkArity(op, args);
- con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
if(con->nPushBack > 0) {
for(j = 0; j < con->nPushBack; j++) free(con->PushBack[j]);
@@ -5173,12 +5189,14 @@
SEXP attribute_hidden
do_getconnection(SEXP call, SEXP op, SEXP args, SEXP env)
{
- SEXP ans, class;
+ SEXP input, conn_id, ans, class;
int what;
+ void *id;
Rconnection con;
checkArity(op, args);
- what = asInteger(CAR(args));
+ input = CAR(args);
+ what = asInteger(input);
if (what == NA_INTEGER)
error(_("there is no connection NA"));
if (what < 0 || what >= NCONNECTIONS || !Connections[what])
@@ -5185,6 +5203,18 @@
error(_("there is no connection %d"), what);
con = Connections[what];
+
+ if (what > 2) {
+ conn_id = getAttrib(input, R_ConnIdSymbol);
+ if (conn_id != R_NilValue) {
+ id = R_ExternalPtrAddr(conn_id);
+ if (!id)
+ error(_("invalid connection ('conn_id' is NULL)"));
+ else if (con->id != id)
+ error(_("invalid connection (non-existing 'conn_id')"));
+ }
+ }
+
PROTECT(ans = ScalarInteger(what));
PROTECT(class = allocVector(STRSXP, 2));
SET_STRING_ELT(class, 0, mkChar(con->class));
@@ -5203,6 +5233,7 @@
checkArity(op, args);
Rcon = getConnection(asInteger(CAR(args)));
+ /* Rcon = R_GetConnection2(CAR(args)); */
PROTECT(ans = allocVector(VECSXP, 7));
PROTECT(names = allocVector(STRSXP, 7));
SET_STRING_ELT(names, 0, mkChar("description"));
@@ -5516,6 +5547,22 @@
return getConnection(asInteger(sConn));
}
+Rconnection R_GetConnection2(SEXP sConn) {
+ int n;
+ SEXP conn_id;
+
+ if (!isInteger(sConn)) error(_("invalid connection (non-integer value)"));
+
+ n = asInteger(sConn);
+
+ if (!inherits(sConn, "connection")) return getConnection(n);
+
+ conn_id = getAttrib(sConn, R_ConnIdSymbol);
+ if (conn_id == R_NilValue) return getConnection(n);
+
+ return getConnection2(n, R_ExternalPtrAddr(conn_id));
+}
+
/* ------------------- (de)compression functions --------------------- */
/* Code for gzcon connections is modelled on gzio.c from zlib 1.2.3 */
@@ -5789,7 +5836,8 @@
checkArity(op, args);
if(!inherits(CAR(args), "connection"))
error(_("'con' is not a connection"));
- incon = getConnection(icon = asInteger(CAR(args)));
+ incon = R_GetConnection2(CAR(args));
+ icon = asInteger(CAR(args));
level = asInteger(CADR(args));
if(level == NA_INTEGER || level < 0 || level > 9)
error(_("'level' must be one of 0 ... 9"));
@@ -6045,7 +6093,7 @@
PROTECT(val = allocVector(LGLSXP, nsock));
for (i = 0; i < nsock; i++) {
- Rconnection conn = getConnection(asInteger(VECTOR_ELT(insock, i)));
+ Rconnection conn = R_GetConnection2(VECTOR_ELT(insock, i));
Rsockconn scp = conn->private;
if (strcmp(conn->class, "sockconn") != 0)
error(_("not a socket connection"));
Index: src/main/dcf.c
===================================================================
--- src/main/dcf.c (revision 75521)
+++ src/main/dcf.c (working copy)
@@ -88,6 +88,7 @@
file = CAR(args);
con = getConnection(asInteger(file));
+ con = R_GetConnection2(file);
wasopen = con->isopen;
if(!wasopen) {
if(!con->open(con)) error(_("cannot open the connection"));
Index: src/main/deparse.c
===================================================================
--- src/main/deparse.c (revision 75521)
+++ src/main/deparse.c (working copy)
@@ -386,6 +386,7 @@
int ifile = asInteger(CADR(args));
if (ifile != 1) {
Rconnection con = getConnection(ifile);
+ con = R_GetConnection2(CADR(args));
RCNTXT cntxt;
Rboolean wasopen = con->isopen;
if(!wasopen) {
@@ -472,6 +473,7 @@
}
else {
Rconnection con = getConnection(INTEGER(file)[0]);
+ con = R_GetConnection2(file);
Rboolean wasopen = con->isopen;
RCNTXT cntxt;
if(!wasopen) {
Index: src/main/saveload.c
===================================================================
--- src/main/saveload.c (revision 75521)
+++ src/main/saveload.c (working copy)
@@ -2335,6 +2335,7 @@
list = CAR(args);
con = getConnection(asInteger(CADR(args)));
+ con = R_GetConnection2(CADR(args));
if (TYPEOF(CADDR(args)) != LGLSXP)
error(_("'ascii' must be logical"));
@@ -2439,6 +2440,7 @@
checkArity(op, args);
con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
wasopen = con->isopen;
if(!wasopen) {
Index: src/main/scan.c
===================================================================
--- src/main/scan.c (revision 75521)
+++ src/main/scan.c (working copy)
@@ -925,6 +925,7 @@
int ii = asInteger(file);
data.con = getConnection(ii);
+ data.con = R_GetConnection2(file);
if(ii == 0) {
data.atStart = FALSE;
data.ttyflag = 1;
Index: src/main/serialize.c
===================================================================
--- src/main/serialize.c (revision 75521)
+++ src/main/serialize.c (working copy)
@@ -2486,6 +2486,7 @@
object = CAR(args);
con = getConnection(asInteger(CADR(args)));
+ con = R_GetConnection2(CADR(args));
if (TYPEOF(CADDR(args)) != LGLSXP)
error(_("'ascii' must be logical"));
@@ -2554,6 +2555,7 @@
checkArity(op, args);
con = getConnection(asInteger(CAR(args)));
+ con = R_GetConnection2(CAR(args));
/* Now we need to do some sanity checking of the arguments.
A filename will already have been opened, so anything
@@ -2649,6 +2651,7 @@
SEXP (*hook)(SEXP, SEXP);
struct bconbuf_st bbs;
Rconnection con = getConnection(asInteger(icon));
+ con = R_GetConnection2(icon);
int version;
if (Sversion == R_NilValue)
@@ -2842,6 +2845,7 @@
}
else {
Rconnection con = getConnection(asInteger(icon));
+ con = R_GetConnection2(icon);
R_InitConnOutPStream(&out, con, type, version, hook, fun);
R_Serialize(object, &out);
return R_NilValue;
@@ -2869,6 +2873,7 @@
return R_Unserialize(&in);
} else {
Rconnection con = getConnection(asInteger(icon));
+ con = R_GetConnection2(icon);
R_InitConnInPStream(&in, con, R_pstream_any_format, hook, fun);
return R_Unserialize(&in);
}
Index: src/main/source.c
===================================================================
--- src/main/source.c (revision 75521)
+++ src/main/source.c (working copy)
@@ -221,9 +221,11 @@
R_ParseError = 0;
R_ParseErrorMsg[0] = '\0';
- ifile = asInteger(CAR(args)); args = CDR(args);
+ ifile = asInteger(CAR(args));
- con = getConnection(ifile);
+ con = R_GetConnection2(CAR(args));
+ args = CDR(args);
+
wasopen = con->isopen;
num = asInteger(CAR(args)); args = CDR(args);
if (num == 0)
______________________________________________
[email protected] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
