Maybe a problem in binary read/write (PR#1688)
accot@free.fr
accot@free.fr
Thu, 20 Jun 2002 20:07:51 +0200 (MET DST)
This is a multi-part message in MIME format.
--------------010901020707080002040305
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit
Hello,
Prof Brian D Ripley wrote:
> Not a bug: check the documentation of file(), which is documented to work
> for files but not for devices. No attempt is made to cope with e.g.
> blocking on non-files.
>
> It's a pretty extreme view of the world to consider /dev/psaux to be a
> file, and R is just using standard C <stdio.h> I/O.
>
> However, this is a great opportunity for you to contribute a device()
> function to R.
I finally checked the code and "wrote" the functions to "handle devices".
Well, in fact I more or less duplicated the code for FIFOs, removed the
option for encoding, added an option for synchronous I/O, and added a
test to check that the file is indeed a character or block special file.
This works great for me but I'm afraid it is a bit simple and does not
cover much of device handling in general. Especially I don't know if
anybody would want to use it for block devices, and what they would need.
The psaux device is one of the simplest device one could think of, that's
why it works so well. For other devices one would need at least an
ioctl function, which I didn't write. But still I have no idea whether
anybody would use it and what for. Anyway. Please let me know if you
think this is useful. If yes, I will try to familiarize myself with
the structure of the R code and make the device handling more general.
Thanks,
Johnny
--------------010901020707080002040305
Content-Type: text/plain;
name="R-1.5.1-device.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="R-1.5.1-device.patch"
diff -ur R-1.5.1.orig/configure R-1.5.1/configure
--- R-1.5.1.orig/configure 2002-06-17 04:20:30.000000000 -0700
+++ R-1.5.1/configure 2002-06-19 19:33:22.000000000 -0700
@@ -17238,8 +17238,9 @@
+
for ac_func in access chdir expm1 fcntl finite ftruncate getcwd \
- getgrgid getpwuid getuid hypot isascii isnan log1p matherr mkfifo \
+ getgrgid getpwuid getuid hypot isascii isnan log1p matherr mkfifo mknod \
popen putenv rint setenv strcoll stat strptime system times unsetenv
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
diff -ur R-1.5.1.orig/configure.ac R-1.5.1/configure.ac
--- R-1.5.1.orig/configure.ac 2002-04-30 11:04:05.000000000 -0700
+++ R-1.5.1/configure.ac 2002-06-19 19:25:04.000000000 -0700
@@ -982,7 +982,7 @@
AC_FUNC_ALLOCA
AC_CHECK_FUNCS(access chdir expm1 fcntl finite ftruncate getcwd \
- getgrgid getpwuid getuid hypot isascii isnan log1p matherr mkfifo \
+ getgrgid getpwuid getuid hypot isascii isnan log1p matherr mkfifo mknod \
popen putenv rint setenv strcoll stat strptime system times unsetenv)
## <NOTE>
## No need checking for bcopy bzero memcpy mempcpy even though ifnames
diff -ur R-1.5.1.orig/src/include/config.h.in R-1.5.1/src/include/config.h.in
--- R-1.5.1.orig/src/include/config.h.in 2002-04-24 02:54:05.000000000 -0700
+++ R-1.5.1/src/include/config.h.in 2002-06-19 19:35:10.000000000 -0700
@@ -216,6 +216,9 @@
/* Define to 1 if you have the `mkfifo' function. */
#undef HAVE_MKFIFO
+/* Define to 1 if you have the `mknod' function. */
+#undef HAVE_MKNOD
+
/* Define to 1 if you have the <ndir.h> header file, and it defines `DIR'. */
#undef HAVE_NDIR_H
diff -ur R-1.5.1.orig/src/include/Internal.h R-1.5.1/src/include/Internal.h
--- R-1.5.1.orig/src/include/Internal.h 2002-04-03 22:51:04.000000000 -0800
+++ R-1.5.1/src/include/Internal.h 2002-06-19 19:25:06.000000000 -0700
@@ -439,6 +439,7 @@
SEXP do_isseekable(SEXP, SEXP, SEXP, SEXP);
SEXP do_close(SEXP, SEXP, SEXP, SEXP);
SEXP do_fifo(SEXP, SEXP, SEXP, SEXP);
+SEXP do_device(SEXP, SEXP, SEXP, SEXP);
SEXP do_pipe(SEXP, SEXP, SEXP, SEXP);
SEXP do_url(SEXP, SEXP, SEXP, SEXP);
SEXP do_gzfile(SEXP, SEXP, SEXP, SEXP);
diff -ur R-1.5.1.orig/src/include/Rconnections.h R-1.5.1/src/include/Rconnections.h
--- R-1.5.1.orig/src/include/Rconnections.h 2002-03-10 05:20:42.000000000 -0800
+++ R-1.5.1/src/include/Rconnections.h 2002-06-19 20:09:26.000000000 -0700
@@ -28,7 +28,7 @@
char* class;
char* description;
char mode[5];
- Rboolean text, isopen, incomplete, canread, canwrite, canseek, blocking;
+ Rboolean text, isopen, incomplete, canread, canwrite, canseek, blocking, sync;
Rboolean (*open)(struct Rconn *);
void (*close)(struct Rconn *); /* routine closing after auto open */
void (*destroy)(struct Rconn *); /* when closing connection */
@@ -58,6 +58,10 @@
int fd;
} *Rfifoconn;
+typedef struct deviceconn {
+ int fd;
+} *Rdeviceconn;
+
typedef struct gzfileconn {
void *fp;
int cp;
diff -ur R-1.5.1.orig/src/library/base/man/connections.Rd R-1.5.1/src/library/base/man/connections.Rd
--- R-1.5.1.orig/src/library/base/man/connections.Rd 2002-03-10 05:20:42.000000000 -0800
+++ R-1.5.1/src/library/base/man/connections.Rd 2002-06-20 10:48:13.000000000 -0700
@@ -4,6 +4,7 @@
\alias{file}
\alias{pipe}
\alias{fifo}
+\alias{device}
\alias{gzfile}
\alias{unz}
\alias{bzfile}
@@ -31,6 +32,7 @@
pipe(description, open = "", encoding = getOption("encoding"))
fifo(description = "", open = "", blocking = FALSE,
encoding = getOption("encoding"))
+device(description = "", open = "", blocking = TRUE, sync = TRUE)
gzfile(description, open = "", encoding = getOption("encoding"),
compression = 6)
unz(description, filename, open = "", encoding = getOption("encoding"))
@@ -62,6 +64,7 @@
\item{open}{character. A description of how to open the connection
(if at all). See Details for possible values.}
\item{blocking}{logical. See `Blocking' section below.}
+ \item{sync}{logical. Should the device be opened for synchronous I/O?}
\item{encoding}{An integer vector of length 256.}
\item{compression}{integer in 0--9. The amount of compression to be
applied when writing, from none to maximal. The default is a good
@@ -74,7 +77,7 @@
\item{\dots}{arguments passed to or from other methods.}
}
\details{
- The first eight functions create connections. By default the
+ The first nine functions create connections. By default the
connection is not opened (except for \code{socketConnection}), but may
be opened by setting a non-empty value of argument \code{open}.
@@ -135,8 +138,8 @@
characters are mapped to a space in these encodings.
}
\value{
- \code{file}, \code{pipe}, \code{fifo}, \code{url}, \code{gzfile} and
- \code{socketConnection} return a connection object
+ \code{file}, \code{pipe}, \code{fifo}, \code{device}, \code{url},
+ \code{gzfile} and \code{socketConnection} return a connection object
which inherits from class \code{"connection"} and has a first more
specific class.
diff -ur R-1.5.1.orig/src/main/connections.c R-1.5.1/src/main/connections.c
--- R-1.5.1.orig/src/main/connections.c 2002-04-30 04:04:02.000000000 -0700
+++ R-1.5.1/src/main/connections.c 2002-06-19 20:12:34.000000000 -0700
@@ -640,6 +640,181 @@
#endif
}
+/* ------------------- device connections --------------------- */
+
+#if defined(HAVE_MKNOD) && defined(HAVE_FCNTL_H)
+
+#ifdef HAVE_STAT
+# ifndef Macintosh
+# ifdef HAVE_SYS_TYPES_H
+# include <sys/types.h>
+# endif
+# ifdef HAVE_SYS_STAT_H
+# include <sys/stat.h>
+# endif
+# else /* Macintosh */
+# include <types.h>
+# ifndef __MRC__
+# include <stat.h>
+# else
+# include <mpw_stat.h>
+# endif
+# endif /* Macintosh */
+#endif /* HAVE_STAT */
+
+#ifdef HAVE_ERRNO_H
+# include <errno.h>
+#endif
+
+static Rboolean device_open(Rconnection con)
+{
+ char *name;
+ Rdeviceconn this = con->private;
+ int fd, flags, res;
+ int mlen = strlen(con->mode);
+ struct stat sb;
+
+ name = R_ExpandFileName(con->description);
+ con->canwrite = (con->mode[0] == 'w' || con->mode[0] == 'a');
+ con->canread = !con->canwrite;
+ if(mlen >= 2 && con->mode[1] == '+') con->canread = TRUE;
+
+ /* check if the device exists and if it is a character or block device */
+ if(con->canwrite) {
+ res = stat(name, &sb);
+ if(res) { /* error, does not exist? */
+ if(errno == ENOENT) warning("device `%s' does not exist", name);
+ else warning("cannot find device `%s'", name);
+ return FALSE;
+ } else {
+ if(!(sb.st_mode & S_IFCHR) && !(sb.st_mode & S_IFBLK)) {
+ warning("`%s' exists but is neither a character special file nor a block special file", name);
+ return FALSE;
+ }
+ }
+ }
+
+ if(con->canread && con->canwrite) flags = O_RDWR;
+ else if(con->canread) flags = O_RDONLY;
+ else flags = O_WRONLY;
+ if(!con->blocking) flags |= O_NONBLOCK;
+ if(con->sync) flags |= O_SYNC;
+ if(con->mode[0] == 'a') flags |= O_APPEND;
+ fd = open(name, flags);
+ if(fd < 0) {
+ if(errno == ENXIO) warning("device `%s' is not ready", name);
+ else warning("cannot open device `%s'", name);
+ return FALSE;
+ }
+
+ this->fd = fd;
+ con->isopen = TRUE;
+
+ if(mlen >= 2 && con->mode[mlen-1] == 'b') con->text = FALSE;
+ else con->text = TRUE;
+ con->save = -1000;
+ return TRUE;
+}
+
+static int device_fgetc(Rconnection con)
+{
+ Rdeviceconn this = (Rdeviceconn)con->private;
+ unsigned char c;
+ int n;
+
+ n = read(this->fd, (char *)&c, 1);
+ return (n == 1) ? c : R_EOF;
+}
+
+static Rconnection newdevice(char *description, char *mode)
+{
+ Rconnection new;
+ new = (Rconnection) malloc(sizeof(struct Rconn));
+ if(!new) error("allocation of device connection failed");
+ new->class = (char *) malloc(strlen("device") + 1);
+ if(!new->class) {
+ free(new);
+ error("allocation of device connection failed");
+ }
+ strcpy(new->class, "device");
+ new->description = (char *) malloc(strlen(description) + 1);
+ if(!new->description) {
+ free(new->class); free(new);
+ error("allocation of device connection failed");
+ }
+ init_con(new, description, mode);
+ new->open = &device_open;
+ new->close = &fifo_close;
+ new->vfprintf = &dummy_vfprintf;
+ new->fgetc = &device_fgetc;
+ new->seek = &null_seek;
+ new->truncate = &null_truncate;
+ new->fflush = &null_fflush;
+ new->read = &fifo_read;
+ new->write = &fifo_write;
+ new->private = (void *) malloc(sizeof(struct deviceconn));
+ if(!new->private) {
+ free(new->description); free(new->class); free(new);
+ error("allocation of device connection failed");
+ }
+ return new;
+}
+#endif
+
+SEXP do_device(SEXP call, SEXP op, SEXP args, SEXP env)
+{
+#if defined(HAVE_MKNOD) && defined(HAVE_FCNTL_H)
+ SEXP sfile, sopen, ans, class;
+ char *file, *open;
+ int i, ncon, block, sync;
+ Rconnection con = NULL;
+
+ checkArity(op, args);
+ sfile = CAR(args);
+ if(!isString(sfile) || length(sfile) < 1)
+ errorcall(call, "invalid `description' argument");
+ if(length(sfile) > 1)
+ warning("only first element of `description' argument used");
+ file = CHAR(STRING_ELT(sfile, 0));
+ sopen = CADR(args);
+ if(!isString(sopen) || length(sopen) != 1)
+ error("invalid `open' argument");
+ block = asLogical(CADDR(args));
+ if(block == NA_LOGICAL)
+ error("invalid `block' argument");
+ sync = asLogical(CADDDR(args));
+ if(sync == NA_LOGICAL)
+ error("invalid `sync' argument");
+ open = CHAR(STRING_ELT(sopen, 0));
+ ncon = NextConnection();
+ con = Connections[ncon] = newdevice(file, strlen(open) ? open : "r");
+ con->blocking = block;
+ con->sync = sync;
+
+ /* open it if desired */
+ if(strlen(open)) {
+ Rboolean success = con->open(con);
+ if(!success) {
+ con_close(ncon);
+ error("unable to open connection");
+ }
+ }
+
+ PROTECT(ans = allocVector(INTSXP, 1));
+ INTEGER(ans)[0] = ncon;
+ PROTECT(class = allocVector(STRSXP, 2));
+ SET_STRING_ELT(class, 0, mkChar("device"));
+ SET_STRING_ELT(class, 1, mkChar("connection"));
+ classgets(ans, class);
+ UNPROTECT(2);
+
+ return ans;
+#else
+ error("device connections are not available on this system");
+ return R_NilValue; /* -Wall */
+#endif
+}
+
/* ------------------- pipe connections --------------------- */
#ifdef HAVE_POPEN
diff -ur R-1.5.1.orig/src/main/names.c R-1.5.1/src/main/names.c
--- R-1.5.1.orig/src/main/names.c 2002-04-04 14:11:31.000000000 -0800
+++ R-1.5.1/src/main/names.c 2002-06-20 10:38:39.000000000 -0700
@@ -692,9 +692,6 @@
{"dev.control", do_devcontrol, 0, 111, 0, PP_FUNCALL},
{"dev.copy", do_devcopy, 0, 111, 1, PP_FUNCALL},
{"dev.cur", do_devcur, 0, 111, 0, PP_FUNCALL},
-/*
-{"device", do_device, 0, 111, 3, PP_FUNCALL},
-*/
{"dev.next", do_devnext, 0, 111, 1, PP_FUNCALL},
{"dev.off", do_devoff, 0, 111, 1, PP_FUNCALL},
{"dev.prev", do_devprev, 0, 111, 1, PP_FUNCALL},
@@ -793,6 +790,7 @@
{"url", do_url, 0, 11, 4, PP_FUNCALL},
{"pipe", do_pipe, 0, 11, 3, PP_FUNCALL},
{"fifo", do_fifo, 0, 11, 4, PP_FUNCALL},
+{"device", do_device, 0, 11, 4, PP_FUNCALL},
{"gzfile", do_gzfile, 0, 11, 4, PP_FUNCALL},
{"unz", do_unz, 0, 11, 3, PP_FUNCALL},
{"bzfile", do_bzfile, 0, 11, 3, PP_FUNCALL},
--------------010901020707080002040305--
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To: r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._