RSclient/0000755000176000001440000000000012176765035012041 5ustar ripleyusersRSclient/src/0000755000176000001440000000000012176747400012624 5ustar ripleyusersRSclient/src/qap.h0000644000176000001440000000145112176747400013557 0ustar ripleyusers#ifndef QAP_H__ #define QAP_H__ #ifndef USE_RINTERNALS #define USE_RINTERNALS 1 #include #endif #define RSERVE_PKG 1 #include "RSprotocol.h" /* NOTE: we only support little-endian machines! */ #define NATIVE_COPY 1 /* stuff to enulate compatibility with Rserve's use */ #define DISABLE_ENCODING 1 #ifndef ptoi #define ptoi(X) X #endif #ifndef itop #define itop(X) ptoi(X) #endif #define fixdcpy(A, B) memcpy(A, B, 8) typedef unsigned long rlen_t; #ifdef ULONG_MAX #define rlen_max ULONG_MAX #else #ifdef __LP64__ #define rlen_max 0xffffffffffffffffL #else #define rlen_max 0xffffffffL #endif /* __LP64__ */ #endif /* ULONG_MAX */ SEXP QAP_decode(unsigned int **buf); rlen_t QAP_getStorageSize(SEXP x); unsigned int* QAP_storeSEXP(unsigned int* buf, SEXP x, rlen_t storage_size); #endif RSclient/src/Makevars0000644000176000001440000000001712176747377014333 0ustar ripleyusersPKG_LIBS=-lssl RSclient/src/sbthread.h0000644000176000001440000000652712176747400014603 0ustar ripleyusers/*****************************************************************\ * sbthread - system-independent basic threads * * (C)Copyright 2001 Simon Urbanek * *---------------------------------------------------------------* * Supported platforms: unix w pthread, Win32 * \*****************************************************************/ #ifndef __SBTHREAD_H__ #define __SBTHREAD_H__ #ifndef WIN32 /* begin unix (pthread) implementation */ #include #define decl_sbthread void * #define sbthread_result(A) (void *)(A) #define sbthread_mutex pthread_mutex_t sbthread_mutex *sbthread_create_mutex() { pthread_mutex_t lm=PTHREAD_MUTEX_INITIALIZER; pthread_mutex_t *m=(pthread_mutex_t *)malloc(sizeof(pthread_mutex_t)); memcpy(m,&lm,sizeof(pthread_mutex_t)); return m; } #define sbthread_lock_mutex(M) pthread_mutex_lock(M); #define sbthread_unlock_mutex(M) pthread_mutex_unlock(M); void sbthread_destroy_mutex(sbthread_mutex *m) { pthread_mutex_destroy(m); free(m); } int sbthread_create(void * (thr)(void *), void *par) { pthread_t Thread; pthread_attr_t ThreadAttr; pthread_attr_init(&ThreadAttr); pthread_attr_setdetachstate(&ThreadAttr,PTHREAD_CREATE_DETACHED); return pthread_create(&Thread,&ThreadAttr,*thr,par); } #else /* end of unix, begin of Win32 */ #include #define decl_sbthread DWORD WINAPI #define sbthread_result(A) (DWORD)(A) #define sbthread_mutex char #ifndef sleep /* this has nothing to do with threads, but may be usefull */ #define sleep(A) Sleep((A)*1000) #endif unsigned int sbthread_mutex_counter=1; sbthread_mutex *sbthread_create_mutex(void) { char mtxn[64],*c; unsigned int i,j; HANDLE m; strcpy(mtxn,"sbthread_mutex"); /* this isn't really thread-safe, but creating more mutexes at exactly the same time by different threads on an SMP machine is ... let's say inprobable. moreover ++ might be atomic. creating yet another mutex for this single operation seems to me as an overkill. but if you need 100% thread-safe code, feel free to implement it here ;) */ sbthread_mutex_counter++; i=15; j=sbthread_mutex_counter; while (j>0) { mtxn[i]=65+(j&15); i++; j>>=4; }; mtxn[i]=0; i++; m=CreateMutex(0,0,mtxn); if (!m) return 0; memcpy(&mtxn[i],&m,sizeof(m)); i+=sizeof(m)*2+1; c=(char*)malloc(i); memcpy(c,mtxn,i); /* content: name\0[createHANDLE][ownershipHANDLE] */ return c; } int sbthread_lock_mutex(sbthread_mutex *m) { HANDLE h; int i; h=OpenMutex(MUTEX_ALL_ACCESS,0,m); if (!h) return 0; if (WaitForSingleObject(h,INFINITE)==WAIT_FAILED) return 0; i=strlen(m); i+=sizeof(h)+1; memcpy(&m[i],&h,sizeof(h)); return 1; } int sbthread_unlock_mutex(sbthread_mutex *m) { HANDLE h; int i; i=strlen(m); i+=sizeof(h)+1; memcpy(&h,&m[i],sizeof(h)); if (!h) return 0; memset(&m[i],0,sizeof(h)); ReleaseMutex(h); CloseHandle(h); return 1; } void sbthread_destroy_mutex(sbthread_mutex *m) { HANDLE h; int i; i=strlen(m); i+=sizeof(h)+1; memcpy(&h,&m[i],sizeof(h)); if (h) return; // oh, mutex is still in use memcpy(&h,&m[i-sizeof(h)],sizeof(h)); CloseHandle(h); free(m); } int sbthread_create(LPTHREAD_START_ROUTINE sa, void *par) { DWORD tid; return CreateThread(0,0,sa,par,0,&tid); } #endif /* Windows implementation */ #endif /* __SBTHREAD_H__ */ RSclient/src/qap_encode.c0000644000176000001440000002160112176747400015066 0ustar ripleyusers#include #include #include "qap.h" #include /* compatibility re-mapping */ #define getStorageSize QAP_getStorageSize #define storeSEXP QAP_storeSEXP /* FIXME: we should move this to some common place ... */ /* string encoding handling */ #if (R_VERSION < R_Version(2,8,0)) || (defined DISABLE_ENCODING) #define mkRChar(X) mkChar(X) #define CHAR_FE(X) CHAR(X) #else #define USE_ENCODING 1 extern cetype_t string_encoding; #define mkRChar(X) mkCharCE((X), string_encoding) #define CHAR_FE(X) charsxp_to_current(X) static const char *charsxp_to_current(SEXP s) { if (Rf_getCharCE(s) == string_encoding) return CHAR(s); return Rf_reEnc(CHAR(s), getCharCE(s), string_encoding, 0); } #endif /* this is the representation of NAs in strings. We chose 0xff since that should never occur in UTF-8 strings. If 0xff occurs in the beginning of a string anyway, it will be doubled to avoid misrepresentation. */ static const unsigned char NaStringRepresentation[2] = { 255, 0 }; #define attrFixup if (hasAttr) buf = storeSEXP(buf, ATTRIB(x), 0); #define dist(A,B) (((rlen_t)(((char*)B)-((char*)A))) - 4L) #define align(A) (((A) + 3L) & (rlen_max ^ 3L)) rlen_t getStorageSize(SEXP x) { int t = TYPEOF(x); rlen_t tl = LENGTH(x); /* although LENGTH can only be 32-bit use rlen_t to avoid downcasting */ rlen_t len = 4; #ifdef RSERV_DEBUG printf("getStorageSize(%p,type=%d,len=%ld) ", (void*)x, t, tl); #endif if (t != CHARSXP && TYPEOF(ATTRIB(x)) == LISTSXP) { rlen_t alen = getStorageSize(ATTRIB(x)); len += alen; } switch (t) { case LISTSXP: case LANGSXP: { SEXP l = x; rlen_t tags = 0, n = 0; while (l != R_NilValue) { len += getStorageSize(CAR(l)); tags += getStorageSize(TAG(l)); n++; l = CDR(l); } if (tags > 4L * n) len += tags; /* use tagged list */ } break; case CLOSXP: len+=getStorageSize(FORMALS(x)); len+=getStorageSize(BODY(x)); break; case CPLXSXP: len += tl * 16L; break; case REALSXP: len += tl * 8L; break; case INTSXP: len += tl * 4L; break; case LGLSXP: case RAWSXP: if (tl > 1) len += 4L + align(tl); else len += 4L; break; case SYMSXP: case CHARSXP: { const char *ct = ((t==CHARSXP) ? CHAR_FE(x) : CHAR_FE(PRINTNAME(x))); if (!ct) len += 4L; else { rlen_t sl = strlen(ct) + 1L; len += align(sl); } } break; case STRSXP: { unsigned int i = 0; while (i < tl) { len += getStorageSize(STRING_ELT(x, i)); i++; } } break; case EXPRSXP: case VECSXP: { unsigned int i = 0; while(i < tl) { len += getStorageSize(VECTOR_ELT(x,i)); i++; } } break; case S4SXP: /* S4 really has the payload in attributes, so it doesn't occupy anything */ break; default: len += 4L; /* unknown types are simply stored as int */ } if (len > 0xfffff0) /* large types must be stored in the new format */ len += 4L; #ifdef RSERV_DEBUG printf("= %lu\n", len); #endif return len; } /* if storage_size is > 0 then it it used instad of a call to getStorageSize() */ unsigned int* storeSEXP(unsigned int* buf, SEXP x, rlen_t storage_size) { int t = TYPEOF(x); int hasAttr = 0; int isLarge = 0; unsigned int *preBuf = buf; rlen_t txlen; if (!x) { /* null pointer will be treated as XT_NULL */ *buf = itop(XT_NULL); buf++; goto didit; } if (t != CHARSXP && TYPEOF(ATTRIB(x)) == LISTSXP) hasAttr = XT_HAS_ATTR; if (t == NILSXP) { *buf = itop(XT_NULL | hasAttr); buf++; attrFixup; goto didit; } /* check storage size */ if (!storage_size) storage_size = getStorageSize(x); txlen = storage_size; if (txlen > 0xfffff0) { /* if the entry is too big, use large format */ isLarge = 1; buf++; } if (t==LISTSXP || t==LANGSXP) { SEXP l = x; rlen_t tags = 0; while (l != R_NilValue) { if (TAG(l) != R_NilValue) tags++; l = CDR(l); } /* note that we are using the fact that XT_LANG_xx=XT_LIST_xx+2 */ *buf = itop((((t == LISTSXP) ? 0 : 2) + (tags ? XT_LIST_TAG : XT_LIST_NOTAG)) | hasAttr); buf++; attrFixup; l = x; while (l != R_NilValue) { buf = storeSEXP(buf, CAR(l), 0); if (tags) buf = storeSEXP(buf, TAG(l), 0); l = CDR(l); } goto didit; } if (t==CLOSXP) { /* closures (send FORMALS and BODY) */ *buf=itop(XT_CLOS|hasAttr); buf++; attrFixup; buf=storeSEXP(buf, FORMALS(x), 0); buf=storeSEXP(buf, BODY(x), 0); goto didit; } if (t==REALSXP) { R_len_t i = 0; *buf=itop(XT_ARRAY_DOUBLE|hasAttr); buf++; attrFixup; #ifdef NATIVE_COPY memcpy(buf, REAL(x), sizeof(double) * LENGTH(x)); buf += LENGTH(x) * sizeof(double) / sizeof(*buf); #else while(i < LENGTH(x)) { fixdcpy(buf, REAL(x) + i); buf += 2; /* sizeof(double)=2*sizeof(int) */ i++; } #endif goto didit; } if (t==CPLXSXP) { R_len_t i = 0; *buf = itop(XT_ARRAY_CPLX|hasAttr); buf++; attrFixup; #ifdef NATIVE_COPY memcpy(buf, COMPLEX(x), LENGTH(x) * sizeof(*COMPLEX(x))); buf += LENGTH(x) * sizeof(*COMPLEX(x)) / sizeof(*buf); #else while(i < LENGTH(x)) { fixdcpy(buf, &(COMPLEX(x)[i].r)); buf += 2; /* sizeof(double)=2*sizeof(int) */ fixdcpy(buf, &(COMPLEX(x)[i].i)); buf += 2; /* sizeof(double)=2*sizeof(int) */ i++; } #endif goto didit; } if (t==RAWSXP) { R_len_t ll = LENGTH(x); *buf = itop(XT_RAW | hasAttr); buf++; attrFixup; *buf = itop(ll); buf++; if (ll) memcpy(buf, RAW(x), ll); ll += 3; ll /= 4; buf += ll; goto didit; } if (t==LGLSXP) { R_len_t ll = LENGTH(x), i = 0; int *lgl = LOGICAL(x); *buf = itop(XT_ARRAY_BOOL | hasAttr); buf++; attrFixup; *buf = itop(ll); buf++; while(i < ll) { /* logical values are stored as bytes of values 0/1/2 */ int bv = lgl[i]; *((unsigned char*)buf) = (bv == 0) ? 0 : (bv==1) ? 1 : 2; buf = (unsigned int*)(((unsigned char*)buf) + 1); i++; } /* pad by 0xff to a multiple of 4 */ while (i & 3) { *((unsigned char*)buf) = 0xff; i++; buf=(unsigned int*)(((unsigned char*)buf) + 1); } goto didit; } if (t == STRSXP) { char *st; R_len_t nx = LENGTH(x), i; *buf = itop(XT_ARRAY_STR|hasAttr); buf++; attrFixup; /* leading int n; is not needed due to the choice of padding */ st = (char *)buf; for (i = 0; i < nx; i++) { const char *cv = CHAR_FE(STRING_ELT(x, i)); rlen_t l = strlen(cv); if (STRING_ELT(x, i) == R_NaString) { cv = (const char*) NaStringRepresentation; l = 1; } else if ((unsigned char) cv[0] == NaStringRepresentation[0]) /* we will double the leading 0xff to avoid abiguity between NA and "\0xff" */ (st++)[0] = (char) NaStringRepresentation[0]; strcpy(st, cv); st += l + 1; } /* pad with '\01' to make sure we can determine the number of elements */ while ((st - (char*)buf) & 3) *(st++) = 1; buf = (unsigned int*)st; goto didit; } if (t==EXPRSXP || t==VECSXP) { R_len_t i = 0, n = LENGTH(x); *buf = itop(((t == EXPRSXP) ? XT_VECTOR_EXP : XT_VECTOR) | hasAttr); buf++; attrFixup; while(i < n) { buf = storeSEXP(buf, VECTOR_ELT(x, i), 0); i++; } goto didit; } if (t==INTSXP) { R_len_t i = 0, n = LENGTH(x); int *iptr = INTEGER(x); *buf = itop(XT_ARRAY_INT | hasAttr); buf++; attrFixup; #ifdef NATIVE_COPY memcpy(buf, iptr, n * sizeof(int)); buf += n; #else while(i < n) { *buf = itop(iptr[i]); buf++; i++; } #endif goto didit; } if (t==S4SXP) { *buf=itop(XT_S4|hasAttr); buf++; attrFixup; goto didit; } if (t==CHARSXP||t==SYMSXP) { rlen_t sl; const char *val; if (t == CHARSXP) { *buf = itop(XT_STR | hasAttr); val = CHAR_FE(x); } else { *buf = itop(XT_SYMNAME | hasAttr); val = CHAR_FE(PRINTNAME(x)); } buf++; attrFixup; strcpy((char*)buf, val); sl = strlen((char*)buf); sl++; while (sl & 3) /* pad by 0 to a length divisible by 4 (since 0.1-10) */ ((char*)buf)[sl++] = 0; buf = (unsigned int*)(((char*)buf) + sl); goto didit; } *buf = itop(XT_UNKNOWN | hasAttr); buf++; attrFixup; *buf = itop(TYPEOF(x)); buf++; didit: if (isLarge) { txlen = dist(preBuf, buf) - 4L; preBuf[0] = itop(SET_PAR(PAR_TYPE(((unsigned char*) preBuf)[4] | XT_LARGE), txlen & 0xffffff)); preBuf[1] = itop(txlen >> 24); } else *preBuf = itop(SET_PAR(PAR_TYPE(ptoi(*preBuf)), dist(preBuf, buf))); #ifdef RSERV_DEBUG printf("stored %p at %p, %lu bytes\n", (void*)x, (void*)preBuf, (unsigned long) dist(preBuf, buf)); #endif if (dist(preBuf, buf) > storage_size) { #ifdef RSERVE_PKG REprintf("**ERROR: underestimated storage %ld / %ld SEXP type %d\n", (long) dist(preBuf, buf), (long) storage_size, TYPEOF(x)); #else fprintf(stderr, "**ERROR: underestimated storage %ld / %ld SEXP type %d\n", (long) dist(preBuf, buf), (long) storage_size, TYPEOF(x)); #endif /* R_inspect(x) // can't use this since it's hidden in R */ } return buf; } RSclient/src/RSprotocol.h0000644000176000001440000004055312176747400015112 0ustar ripleyusers/* * RSprotocol.h : constants and macros for Rserve client/server architecture * This file is based on Rserv's Rsrv.h but extracts only constants * and macros * * Copyright (C) 2002-12 Simon Urbanek * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 of the License * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * Note: This header file is licensed under LGPL to allow other * programs to use it under LGPL. Rserve itself is licensed under GPL. * * $Id: Rsrv.h 379 2012-05-21 22:21:57Z urbanek $ */ /* external defines: MAIN - should be defined in just one file that will contain the fn definitions and variables */ #ifndef __RSRV_H__ #define __RSRV_H__ #define default_Rsrv_port 6311 /* Rserve communication is done over any reliable connection-oriented protocol (usually TCP/IP or local sockets). After the connection is established, the server sends 32 bytes of ID-string defining the capabilities of the server. Each attribute of the ID-string is 4 bytes long and is meant to be user-readable (i.e. don't use special characters), and it's a good idea to make "\r\n\r\n" the last attribute the ID string must be of the form: [0] "Rsrv" - R-server ID signature [4] "0100" - version of the R server [8] "QAP1" - protocol used for communication (here Quad Attributes Packets v1) [12] any additional attributes follow. \r\n and '-' are ignored. optional attributes (in any order; it is legitimate to put dummy attributes, like "----" or " " between attributes): "R151" - version of R (here 1.5.1) "ARpt" - authorization required (here "pt"=plain text, "uc"=unix crypt, "m5"=MD5) connection will be closed if the first packet is not CMD_login. if more AR.. methods are specified, then client is free to use the one he supports (usually the most secure) "K***" - key if encoded authentification is challenged (*** is the key) for unix crypt the first two letters of the key are the salt required by the server */ /* QAP1 transport protocol header structure all int and double entries throughout the transfer are in Intel-endianess format: int=0x12345678 -> char[4]=(0x78,0x56,x34,0x12) functions/macros for converting from native to protocol format are available below Please note also that all values muse be quad-aligned, i.e. the length must be divisible by 4. This is automatically assured for int/double etc., but care must be taken when using strings and byte streams. */ struct phdr { /* always 16 bytes */ int cmd; /* command */ int len; /* length of the packet minus header (ergo -16) */ int dof; /* data offset behind header (ergo usually 0) */ int res; /* high 32-bit of the packet length (since 0103 and supported on 64-bit platforms only) aka "lenhi", but the name was not changed to maintain compatibility */ }; /* each entry in the data section (aka parameter list) is preceded by 4 bytes: 1 byte : parameter type 3 bytes: length parameter list may be terminated by 0/0/0/0 but doesn't have to since "len" field specifies the packet length sufficiently (hint: best method for parsing is to allocate len+4 bytes, set the last 4 bytes to 0 and trverse list of parameters until (int)0 occurs since 0102: if the 7-th bit (0x40) in parameter type is set then the length is encoded in 7 bytes enlarging the header by 4 bytes. */ /* macros for handling the first int - split/combine (24-bit version only!) */ #define PAR_TYPE(X) ((X) & 255) #define PAR_LEN(X) (((unsigned int)(X)) >> 8) #define PAR_LENGTH PAR_LEN #define SET_PAR(TY,LEN) ((((unsigned int) (LEN) & 0xffffff) << 8) | ((TY) & 255)) #define CMD_STAT(X) (((X) >> 24)&127) /* returns the stat code of the response */ #define SET_STAT(X,s) ((X) | (((s) & 127) << 24)) /* sets the stat code */ #define CMD_FULL(X) ((X) & 0xfffff) /* lower 20-bit are used by the command (class + cmd) */ #define CMD_CLASS(X) ((X) & 0xf0000) /* get command class */ #define CMD_CLASS_RSERVE 0x00000 /* regular Rserve commands */ #define CMD_CLASS_RESPONSE 0x10000 /* response to Rserve commands */ #define CMD_CLASS_OOB 0x20000 /* OOB commands */ #define CMD_CLASS_PROXY 0x40000 /* proxy commands (filtered out by proxies) */ #define CMD_RESP CMD_CLASS_RESPONSE /* all responses have this flag set */ #define RESP_OK (CMD_RESP|0x0001) /* command succeeded; returned parameters depend on the command issued */ #define RESP_ERR (CMD_RESP|0x0002) /* command failed, check stats code attached string may describe the error */ #define CMD_OOB CMD_CLASS_OOB /* out-of-band data - i.e. unsolicited messages */ #define OOB_SEND (CMD_OOB | 0x1000) /* OOB send - unsolicited SEXP sent from the R instance to the client. 12 LSB are reserved for application-specific code */ #define OOB_MSG (CMD_OOB | 0x2000) /* OOB message - unsolicited message sent from the R instance to the client requiring a response. 12 LSB are reserved for application-specific code */ #define OOB_STREAM_READ (CMD_OOB | 0x4000) /* OOB stream read request - server requests streaming data from the client (typically streaming input for computation) */ #define IS_OOB_SEND(X) (((X) & 0x0ffff000) == OOB_SEND) #define IS_OOB_MSG(X) (((X) & 0x0ffff000) == OOB_MSG) #define IS_OOB_STREAM_READ(X) (((X) & 0x0ffff000) == OOB_STREAM_READ) #define OOB_USR_CODE(X) ((X) & 0xfff) #define CMD_PROXY_TARGET (CMD_CLASS_PROXY | 0x01) /* payload is NUL-terminted string defining the desired target host:port -- IPv6 addresses must be quoted in [] */ #define CMD_PROXY_GET_SLOT (CMD_CLASS_PROXY | 0x02) /* no payload, lock-in a slot for connection-limited hosts, proxy closes connection if the target slot is unavailable at this point */ /* flag for create_server: Use QAP object-cap mode */ #define SRV_QAP_OC 0x40 /* stat codes; 0-0x3f are reserved for program specific codes - e.g. for R connection they correspond to the stat of Parse command. the following codes are returned by the Rserv itself codes <0 denote Rerror as provided by R_tryEval */ #define ERR_auth_failed 0x41 /* auth.failed or auth.requested but no login came. in case of authentification failure due to name/pwd mismatch, server may send CMD_accessDenied instead */ #define ERR_conn_broken 0x42 /* connection closed or broken packet killed it */ #define ERR_inv_cmd 0x43 /* unsupported/invalid command */ #define ERR_inv_par 0x44 /* some parameters are invalid */ #define ERR_Rerror 0x45 /* R-error occured, usually followed by connection shutdown */ #define ERR_IOerror 0x46 /* I/O error */ #define ERR_notOpen 0x47 /* attempt to perform fileRead/Write on closed file */ #define ERR_accessDenied 0x48 /* this answer is also valid on CMD_login; otherwise it's sent if the server deosn;t allow the user to issue the specified command. (e.g. some server admins may block file I/O operations for some users) */ #define ERR_unsupportedCmd 0x49 /* unsupported command */ #define ERR_unknownCmd 0x4a /* unknown command - the difference between unsupported and unknown is that unsupported commands are known to the server but for some reasons (e.g. platform dependent) it's not supported. unknown commands are simply not recognized by the server at all. */ /* The following ERR_.. exist since 1.23/0.1-6 */ #define ERR_data_overflow 0x4b /* incoming packet is too big. currently there is a limit as of the size of an incoming packet. */ #define ERR_object_too_big 0x4c /* the requested object is too big to be transported in that way. If received after CMD_eval then the evaluation itself was successful. optional parameter is the size of the object */ /* since 1.29/0.1-9 */ #define ERR_out_of_mem 0x4d /* out of memory. the connection is usually closed after this error was sent */ /* since 0.6-0 */ #define ERR_ctrl_closed 0x4e /* control pipe to the master process is closed or broken */ /* since 0.4-0 */ #define ERR_session_busy 0x50 /* session is still busy */ #define ERR_detach_failed 0x51 /* unable to detach seesion (cannot determine peer IP or problems creating a listening socket for resume) */ /* since 1.7 */ #define ERR_disabled 0x61 /* feature is disabled */ #define ERR_unavailable 0x62 /* feature is not present in this build */ #define ERR_cryptError 0x63 /* crypto-system error */ #define ERR_securityClose 0x64 /* server-initiated close due to security violation (too many attempts, excessive timeout etc.) */ /* availiable commands */ #define CMD_login 0x001 /* "name\npwd" : - */ #define CMD_voidEval 0x002 /* string : - */ #define CMD_eval 0x003 /* string : encoded SEXP */ #define CMD_shutdown 0x004 /* [admin-pwd] : - */ /* security/encryption - all since 1.7-0 */ #define CMD_switch 0x005 /* string (protocol) : - */ #define CMD_keyReq 0x006 /* string (request) : bytestream (key) */ #define CMD_secLogin 0x007 /* bytestream (encrypted auth) : - */ #define CMD_OCcall 0x00f /* SEXP : SEXP -- it is the only command supported in object-capability mode and it requires that the SEXP is a language construct with OC reference in the first position */ #define CMD_OCinit 0x434f7352 /* SEXP -- 'RsOC' - command sent from the server in OC mode with the packet of initial capabilities. */ /* file I/O routines. server may answe */ #define CMD_openFile 0x010 /* fn : - */ #define CMD_createFile 0x011 /* fn : - */ #define CMD_closeFile 0x012 /* - : - */ #define CMD_readFile 0x013 /* [int size] : data... ; if size not present, server is free to choose any value - usually it uses the size of its static buffer */ #define CMD_writeFile 0x014 /* data : - */ #define CMD_removeFile 0x015 /* fn : - */ /* object manipulation */ #define CMD_setSEXP 0x020 /* string(name), REXP : - */ #define CMD_assignSEXP 0x021 /* string(name), REXP : - ; same as setSEXP except that the name is parsed */ /* session management (since 0.4-0) */ #define CMD_detachSession 0x030 /* : session key */ #define CMD_detachedVoidEval 0x031 /* string : session key; doesn't */ #define CMD_attachSession 0x032 /* session key : - */ /* control commands (since 0.6-0) - passed on to the master process */ /* Note: currently all control commands are asychronous, i.e. RESP_OK indicates that the command was enqueued in the master pipe, but there is no guarantee that it will be processed. Moreover non-forked connections (e.g. the default debug setup) don't process any control commands until the current client connection is closed so the connection issuing the control command will never see its result. */ #define CMD_ctrl 0x40 /* -- not a command - just a constant -- */ #define CMD_ctrlEval 0x42 /* string : - */ #define CMD_ctrlSource 0x45 /* string : - */ #define CMD_ctrlShutdown 0x44 /* - : - */ /* 'internal' commands (since 0.1-9) */ #define CMD_setBufferSize 0x081 /* [int sendBufSize] this commad allow clients to request bigger buffer sizes if large data is to be transported from Rserve to the client. (incoming buffer is resized automatically) */ #define CMD_setEncoding 0x082 /* string (one of "native","latin1","utf8") : -; since 0.5-3 */ /* special commands - the payload of packages with this mask does not contain defined parameters */ #define CMD_SPECIAL_MASK 0xf0 #define CMD_serEval 0xf5 /* serialized eval - the packets are raw serialized data without data header */ #define CMD_serAssign 0xf6 /* serialized assign - serialized list with [[1]]=name, [[2]]=value */ #define CMD_serEEval 0xf7 /* serialized expression eval - like serEval with one additional evaluation round */ /* data types for the transport protocol (QAP1) do NOT confuse with XT_.. values. */ #define DT_INT 1 /* int */ #define DT_CHAR 2 /* char */ #define DT_DOUBLE 3 /* double */ #define DT_STRING 4 /* 0 terminted string */ #define DT_BYTESTREAM 5 /* stream of bytes (unlike DT_STRING may contain 0) */ #define DT_SEXP 10 /* encoded SEXP */ #define DT_ARRAY 11 /* array of objects (i.e. first 4 bytes specify how many subsequent objects are part of the array; 0 is legitimate) */ #define DT_LARGE 64 /* new in 0102: if this flag is set then the length of the object is coded as 56-bit integer enlarging the header by 4 bytes */ /* XpressionTypes REXP - R expressions are packed in the same way as command parameters transport format of the encoded Xpressions: [0] int type/len (1 byte type, 3 bytes len - same as SET_PAR) [4] REXP attr (if bit 8 in type is set) [4/8] data .. */ #define XT_NULL 0 /* P data: [0] */ #define XT_INT 1 /* - data: [4]int */ #define XT_DOUBLE 2 /* - data: [8]double */ #define XT_STR 3 /* P data: [n]char null-term. strg. */ #define XT_LANG 4 /* - data: same as XT_LIST */ #define XT_SYM 5 /* - data: [n]char symbol name */ #define XT_BOOL 6 /* - data: [1]byte boolean (1=TRUE, 0=FALSE, 2=NA) */ #define XT_S4 7 /* P data: [0] */ #define XT_VECTOR 16 /* P data: [?]REXP,REXP,.. */ #define XT_LIST 17 /* - X head, X vals, X tag (since 0.1-5) */ #define XT_CLOS 18 /* P X formals, X body (closure; since 0.1-5) */ #define XT_SYMNAME 19 /* s same as XT_STR (since 0.5) */ #define XT_LIST_NOTAG 20 /* s same as XT_VECTOR (since 0.5) */ #define XT_LIST_TAG 21 /* P X tag, X val, Y tag, Y val, ... (since 0.5) */ #define XT_LANG_NOTAG 22 /* s same as XT_LIST_NOTAG (since 0.5) */ #define XT_LANG_TAG 23 /* s same as XT_LIST_TAG (since 0.5) */ #define XT_VECTOR_EXP 26 /* s same as XT_VECTOR (since 0.5) */ #define XT_VECTOR_STR 27 /* - same as XT_VECTOR (since 0.5 but unused, use XT_ARRAY_STR instead) */ #define XT_ARRAY_INT 32 /* P data: [n*4]int,int,.. */ #define XT_ARRAY_DOUBLE 33 /* P data: [n*8]double,double,.. */ #define XT_ARRAY_STR 34 /* P data: string,string,.. (string=byte,byte,...,0) padded with '\01' */ #define XT_ARRAY_BOOL_UA 35 /* - data: [n]byte,byte,.. (unaligned! NOT supported anymore) */ #define XT_ARRAY_BOOL 36 /* P data: int(n),byte,byte,... */ #define XT_RAW 37 /* P data: int(n),byte,byte,... */ #define XT_ARRAY_CPLX 38 /* P data: [n*16]double,double,... (Re,Im,Re,Im,...) */ #define XT_UNKNOWN 48 /* P data: [4]int - SEXP type (as from TYPEOF(x)) */ /* | +--- interesting flags for client implementations: P = primary type s = secondary type - its decoding is identical to a primary type and thus the client doesn't need to decode it separately. - = deprecated/removed. if a client doesn't need to support old Rserve versions, those can be safely skipped. Total primary: 4 trivial types (NULL, STR, S4, UNKNOWN) + 6 array types + 3 recursive types */ #define XT_LARGE 64 /* new in 0102: if this flag is set then the length of the object is coded as 56-bit integer enlarging the header by 4 bytes */ #define XT_HAS_ATTR 128 /* flag; if set, the following REXP is the attribute */ /* the use of attributes and vectors results in recursive storage of REXPs */ #define BOOL_TRUE 1 #define BOOL_FALSE 0 #define BOOL_NA 2 #define GET_XT(X) ((X)&63) #define GET_DT(X) ((X)&63) #define HAS_ATTR(X) (((X)&XT_HAS_ATTR)>0) #define IS_LARGE(X) (((X)&XT_LARGE)>0) #endif RSclient/src/cli.c0000644000176000001440000011214012176747400013536 0ustar ripleyusers/* (C)Copyright 2012 Simon Urbanek. Released under GPL v2, no warranties. */ #include #include #include #include #include #include #ifdef WIN32 #include #include #define USE_TLS 1 static int wsock_up = 0; #define MAX_RECV 65536 #else #define MAX_RECV (512*1025) #define closesocket(C) close(C) #include #include #include #include #include #ifndef AF_LOCAL #define AF_LOCAL AF_UNIX #endif /* until we use confgiure we hard-code TLS use for now */ #define USE_TLS 1 /* and we enable IPv6 if we see it */ #ifdef AF_INET6 #define USE_IPV6 1 #endif #endif #include #include #include #ifdef USE_THREADS #include "sbthread.h" #endif #ifdef USE_TLS #include #include #include #endif #define USE_RINTERNALS #include /* asynchronous connection status */ #define ACS_CONNECTING 1 #define ACS_CONNECTED 2 #define ACS_IOERR -1 #define ACS_HSERR -2 /* handshake error */ typedef struct rsconn { int s, intr, in_cmd, thread, port; void *tls; unsigned int send_len, send_alloc; char *send_buf, *host; FILE *stream; const char *last_error; SEXP oob_send_cb, oob_msg_cb; int (*send)(struct rsconn *, const void *, int); int (*recv)(struct rsconn *, void *, int); } rsconn_t; #define rsc_ok(X) (((X)->s) != -1) #define IOerr(C, X) { C->last_error = X; if ((C)->thread) { (C)->thread = ACS_IOERR; return -1; } else Rf_error(X); } static int sock_send(rsconn_t *c, const void *buf, int len) { if (c->s == -1) IOerr(c, "connection is already closed"); if (c->intr) { closesocket(c->s); c->s = -1; IOerr(c, "previous operation was interrupted, connection aborted"); } return send(c->s, buf, len, 0); } #if defined EAGAIN && ! defined EWOULDBLOCK #define EWOULDBLOCK EAGAIN #endif #if ! defined EAGAIN && defined EWOULDBLOCK #define EAGAIN EWOULDBLOCK #endif static int sock_recv(rsconn_t *c, void *buf, int len) { char* cb = (char*) buf; if (c->intr && c->s != -1) { closesocket(c->s); c->s = -1; IOerr(c, "previous operation was interrupted, connection aborted"); } while (len > 0) { int n = recv(c->s, cb, len, 0); /* fprintf(stderr, "sock_recv(%d) = %d [errno=%d]\n", len, n, errno); */ /* bail out only on non-timeout errors */ if (n == -1 && errno != EAGAIN && errno != EWOULDBLOCK) return -1; if (n == 0) break; if (n > 0) { cb += n; len -= n; } if (len) { c->intr = 1; R_CheckUserInterrupt(); c->intr = 0; } } return (int) (cb - (char*)buf); } #ifdef USE_TLS static int tls_send(rsconn_t *c, const void *buf, int len) { return SSL_write((SSL*)c->tls, buf, len); } static int tls_recv(rsconn_t *c, void *buf, int len) { return SSL_read((SSL*)c->tls, buf, len); } static int first_tls = 1; #include static void init_tls() { if (first_tls) { SSL_library_init(); SSL_load_error_strings(); first_tls = 0; } } static int tls_upgrade(rsconn_t *c) { SSL *ssl; SSL_CTX *ctx; if (first_tls) init_tls(); ctx = SSL_CTX_new(SSLv23_client_method()); SSL_CTX_set_mode(ctx, SSL_MODE_AUTO_RETRY); c->tls = ssl = SSL_new(ctx); c->send = tls_send; c->recv = tls_recv; SSL_set_fd(ssl, c->s); /* SSL_CTX_free(ctx) // check whether this is safe - it should be since ssl has the reference ... */ return SSL_connect(ssl); } #endif /* we split alloc and connect so alloc can be done on the main thread and connect on a separate one */ static rsconn_t *rsc_alloc() { rsconn_t *c = (rsconn_t*) calloc(sizeof(rsconn_t), 1); #ifdef WIN32 if (!wsock_up) { WSADATA dt; /* initialize WinSock 2.0 (WSAStringToAddress is 2.0 feature) */ WSAStartup(MAKEWORD(2,0), &dt); wsock_up = 1; } #endif c->intr = 0; c->thread = 0; c->s = -1; c->send_alloc = 65536; c->send_len = 0; c->send_buf = (char*) malloc(c->send_alloc); c->tls = 0; c->in_cmd = 0; c->oob_send_cb = R_NilValue; c->oob_msg_cb = R_NilValue; c->send = sock_send; c->recv = sock_recv; if (!c->send_buf) { free(c); return 0; } return c; } static rsconn_t *rsc_connect_ex(const char *host, int port, rsconn_t *c) { int family, connected = 0; #ifdef WIN32 family = AF_INET; #else family = port ? AF_INET : AF_LOCAL; #endif #ifdef USE_IPV6 /* we use getaddrinfo to have the system figure the family and address for us */ /* FIXME: is there any reason we don't use that in general? Do all systems support this? */ if (host && family == AF_INET) { struct addrinfo hints, *ail = 0, *ai; char port_s[8]; snprintf(port_s, sizeof(port_s), "%d", port); memset(&hints, 0, sizeof(hints)); hints.ai_family = PF_UNSPEC; hints.ai_socktype = SOCK_STREAM; if (getaddrinfo(host, port_s, &hints, &ail) == 0) { for (ai = ail; ai; ai = ai->ai_next) if (ai->ai_family == AF_INET || ai->ai_family == AF_INET6) { c->s = socket(ai->ai_family, SOCK_STREAM, ai->ai_protocol); if (c->s != -1) { if (connect(c->s, ai->ai_addr, ai->ai_addrlen) == 0) break; /* didn't work - try another address (if ther are any) */ closesocket(c->s); c->s = -1; } } if (ail) freeaddrinfo(ail); } if (c->s != -1) /* the socket will be valid only if connect() succeeded */ connected = 1; } else #endif c->s = socket(family, SOCK_STREAM, 0); #ifdef SO_RCVTIMEO { /* set receive timeout so we can interrupt read operations */ struct timeval tv; tv.tv_sec = 0; tv.tv_usec = 200000; /* 200ms */ setsockopt(c->s, SOL_SOCKET, SO_RCVTIMEO, &tv, sizeof(tv)); } #endif if (c->s != -1 && !connected) { if (family == AF_INET) { struct sockaddr_in sin; struct hostent *haddr; sin.sin_family = AF_INET; sin.sin_port = htons(port); if (host) { #ifdef WIN32 int al = sizeof(sin); if (WSAStringToAddress((LPSTR)host, sin.sin_family, 0, (struct sockaddr*)&sin, &al) != 0) { if (!(haddr = gethostbyname(host))) { /* DNS failed, */ closesocket(c->s); c->s = -1; } sin.sin_addr.s_addr = *((uint32_t*) haddr->h_addr); /* pick first address */ } /* for some reason Windows trashes the structure so we need to fill it again */ sin.sin_family = AF_INET; sin.sin_port = htons(port); #else if (inet_pton(sin.sin_family, host, &sin.sin_addr) != 1) { /* invalid, try DNS */ if (!(haddr = gethostbyname(host))) { /* DNS failed, */ closesocket(c->s); c->s = -1; } sin.sin_addr.s_addr = *((uint32_t*) haddr->h_addr); /* pick first address */ } #endif } else sin.sin_addr.s_addr = htonl(INADDR_LOOPBACK); if (c->s != -1 && connect(c->s, (struct sockaddr*)&sin, sizeof(sin))) { closesocket(c->s); c->s = -1; } } else { #ifndef WIN32 struct sockaddr_un sau; memset(&sau, 0, sizeof(sau)); sau.sun_family = AF_LOCAL; if (strlen(host) + 1 > sizeof(sau.sun_path)) { closesocket(c->s); c->s = -1; } else strcpy(sau.sun_path, host); if (c->s != -1 && connect(c->s, (struct sockaddr*)&sau, sizeof(sau))) { closesocket(c->s); c->s = -1; } #else /* this should never happen */ c->s = -1; #endif } } if (c->s == -1) { free(c->send_buf); free(c); return 0; } return c; } static rsconn_t *rsc_connect(const char *host, int port) { rsconn_t *c = rsc_alloc(); if (!c) return c; return rsc_connect_ex(host, port, c); } static int rsc_abort(rsconn_t *c, const char *reason) { #if USE_TLS if (!c->thread) { long tc = ERR_get_error(); if (tc) { char *te = ERR_error_string(tc, 0); if (te) REprintf("TLS error: %s\n", te); } } #endif if (c->s != -1) closesocket(c->s); c->s = -1; c->in_cmd = 0; c->last_error = reason; if (!c->thread) REprintf("rsc_abort: %s\n", reason); return -1; } static int rsc_flush(rsconn_t *c) { if (c->s == -1) IOerr(c, "connection lost"); if (c->s != -1 && c->send_len) { int n, sp = 0; #if RC_DEBUG int i; fprintf(stderr, "INFO.send:"); for (i = 0; i < c->send_len; i++) fprintf(stderr, " %02x", (int) ((uint8_t*)c->send_buf)[i]); fprintf(stderr, " "); for (i = 0; i < c->send_len; i++) fprintf(stderr, "%c", (((uint8_t*)c->send_buf)[i] > 31 && ((uint8_t*)c->send_buf)[i] < 128) ? ((uint8_t*)c->send_buf)[i] : '.'); fprintf(stderr, "\n"); #endif while (sp < c->send_len && (n = c->send(c, c->send_buf + sp, c->send_len - sp)) > 0) sp += n; if (sp < c->send_len) rsc_abort(c, "send error"); } c->send_len = 0; return 0; } static void rsc_close(rsconn_t *c) { if (!c) return; if (c->s != -1) rsc_flush(c); #ifdef USE_TLS if (c->tls) { if (SSL_shutdown((SSL*)c->tls) == 0) SSL_shutdown((SSL*)c->tls); SSL_free((SSL*)c->tls); c->tls = 0; } #endif if (c->s != -1) closesocket(c->s); if (c->host) free(c->host); free(c->send_buf); free(c); } static long rsc_write(rsconn_t *c, const void *buf, long len) { const char *cb = (const char*) buf; while (c->send_len + len > c->send_alloc) { int ts = c->send_alloc - c->send_len; if (ts) { memcpy(c->send_buf + c->send_len, cb, ts); c->send_len += ts; cb += ts; len -= ts; } rsc_flush(c); } memcpy(c->send_buf + c->send_len, cb, len); c->send_len += len; return (c->s == -1) ? -1 : len; } static long rsc_read(rsconn_t *c, void *buf, long needed) { char *ptr = (char*) buf; if (needed < 0) return rsc_abort(c, "attempt to read negative number of bytes (integer overflow?)"); if (c->s == -1) return -1; while (needed > 0) { int n = c->recv(c, ptr, (needed > MAX_RECV) ? MAX_RECV : needed); if (n < 0) return rsc_abort(c, "read error"); if (n == 0) return rsc_abort(c, "connection closed by peer"); #if RC_DEBUG int i; fprintf(stderr, "INFO.recv:"); for (i = 0; i < n; i++) fprintf(stderr, " %02x", (int) ((unsigned char*)ptr)[i]); fprintf(stderr, " "); for (i = 0; i < n; i++) fprintf(stderr, "%c", (((unsigned char*)ptr)[i] > 31 && ((unsigned char*)ptr)[i] < 128) ? ((unsigned char*)ptr)[i] : '.'); fprintf(stderr, "\n"); #endif ptr += n; needed -= n; } return (long) (ptr - (char*) buf); } /* Note: OC handshake also uses the slurp buffer as scratch */ static char slurp_buffer[65536]; static long rsc_slurp(rsconn_t *c, long needed) { long len = needed; while (needed > 0) { int n = c->recv(c, slurp_buffer, (needed > sizeof(slurp_buffer)) ? sizeof(slurp_buffer) : needed); if (n < 0) return rsc_abort(c, "read error"); if (n == 0) return rsc_abort(c, "connection closed by peer"); needed -= n; } return len; } /* Rserve protocol */ #include "RSprotocol.h" #include "qap.h" /* --- R API -- */ #define R2UTF8(X) translateCharUTF8(STRING_ELT(X, 0)) static void rsconn_fin(SEXP what) { rsconn_t *c = (rsconn_t*) EXTPTR_PTR(what); if (c) rsc_close(c); } 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; } SEXP RS_close(SEXP sc) { rsconn_t *c; if (!inherits(sc, "RserveConnection")) Rf_error("invalid connection"); c = (rsconn_t*) EXTPTR_PTR(sc); if (!c) return R_NilValue; /* we can't use rsc_close because it frees the connection object */ closesocket(c->s); c->s = -1; c->in_cmd = 0; return R_NilValue; } static const char *rs_status_string(int status) { switch (status) { case 0: return "(status is OK)"; case 127: case 1: return "error in R during evaluation"; case 2: return "R parser: input incomplete"; case 3: return "R parser: error in the expression"; case 4: return "R parser: EOF reached"; case ERR_auth_failed: return "authentication failed"; case ERR_conn_broken: return "connection is broken"; case ERR_inv_cmd: return "invalid command"; case ERR_inv_par: return "invalid command parameter"; case ERR_Rerror: return "fatal R-side error"; case ERR_IOerror: return "I/O error on the server"; case ERR_notOpen: return "I/O operation on a closed file"; case ERR_accessDenied: return "access denied"; case ERR_unsupportedCmd: return "unsupported command"; case ERR_unknownCmd: return "unknown command"; case ERR_data_overflow: return "data overflow"; case ERR_object_too_big: return "object is too big"; case ERR_out_of_mem: return "out of memory"; case ERR_ctrl_closed: return "no control line present (control commands disabled or server shutdown)"; case ERR_session_busy: return "session is busy"; case ERR_detach_failed: return "unable to detach session"; case ERR_disabled: return "feature is disabled"; case ERR_unavailable: return "feature is not available in this build of the server"; case ERR_cryptError: return "crypto-system error"; case ERR_securityClose: return "connection closed due to security violation"; } return "(unknown error code)"; } #ifdef USE_THREADS /* threaded version - can be run ona separate threads, does not use any R API and responds with ERR_unsupportedCmd to OOB commands */ static long get_hdr_mt(rsconn_t *c, struct phdr *hdr) { long tl = 0; while (1) { if (rsc_read(c, hdr, sizeof(*hdr)) != sizeof(*hdr)) { c->in_cmd = 0; closesocket(c->s); c->s = -1; IOerr(c, "read error - could not obtain response header"); } #if LONG_MAX > 2147483647 tl = hdr->res; tl <<= 32; tl |= hdr->len; #else tl = hdr->len; #endif /* OOB is not supported in MT mode */ if (hdr->cmd & CMD_OOB) { struct phdr rhdr; int err = 0; memset(&rhdr, 0, sizeof(rhdr)); /* FIXME: Rserve has a bug(?) that sets CMD_RESP on OOB commands so we clear it for now ... */ hdr->cmd &= ~CMD_RESP; if (IS_OOB_STREAM_READ(hdr->cmd)) { /* the only request we allow is stream read */ if (!c->stream || OOB_USR_CODE(hdr->cmd)) { /* we support only one stream - if present */ rsc_slurp(c, tl); err = ERR_notOpen; } else if (tl > 16) { rsc_slurp(c, tl); err = ERR_inv_par; } else { /* the request size is limited by the send buffer */ unsigned int req_off = 16 /* msg hdr */ + 4 /* par hdr */; unsigned int req_size = c->send_alloc - req_off; if (tl) { unsigned int b[4]; int n = c->recv(c, b, tl); if (n < tl) { c->in_cmd = 0; rsc_abort(c, "Read error in parsing OOB_STREAM_READ parameters"); return -1; } /* FIXME: we need to fix endianness on bigendian machines - but this is true elewhere! */ if (PAR_TYPE(b[0]) != DT_INT || PAR_LEN(b[0]) != sizeof(b[1]) || b[1] == 0) err = ERR_inv_par; else { /* we limit the request size */ if (b[1] < req_size) req_size = b[1]; /* flush the send buffer so it's guaranteed empty */ rsc_flush(c); n = fread(c->send_buf + req_off, 1, req_size, c->stream); if (n < 0) { err = ERR_IOerror; fclose(c->stream); c->stream = 0; } else { unsigned int *sb = (unsigned int*) (c->send_buf); sb[0] = OOB_STREAM_READ | RESP_OK; sb[2] = sb[3] = 0; if (n) { sb[1] = n + 4; sb[4] = SET_PAR(DT_BYTESTREAM, n); c->send_len = req_off + n; } else { sb[1] = 0; c->send_len = 16; /* jsut the header */ } /* we have populated the send buffer by hand, jsut flush it */ rsc_flush(c); } } } } } else { rsc_slurp(c, tl); err = ERR_unsupportedCmd; } if (err) { rhdr.cmd = err | CMD_RESP; rsc_write(c, &rhdr, sizeof(rhdr)); rsc_flush(c); } } else break; } c->in_cmd = 0; return tl; } #endif static long get_hdr(SEXP sc, rsconn_t *c, struct phdr *hdr) { long tl = 0; while (1) { if (rsc_read(c, hdr, sizeof(*hdr)) != sizeof(*hdr)) { c->in_cmd = 0; RS_close(sc); Rf_error("read error - could not obtain response header"); } #if LONG_MAX > 2147483647 tl = hdr->res; tl <<= 32; tl |= hdr->len; #else tl = hdr->len; #endif if (hdr->cmd & CMD_OOB) { SEXP res, ee = R_NilValue; unsigned int *ibuf; PROTECT(res = allocVector(RAWSXP, tl)); if (rsc_read(c, RAW(res), tl) != tl) { c->in_cmd = 0; RS_close(sc); Rf_error("read error in OOB message"); } ibuf = (unsigned int*) RAW(res); /* FIXME: we assume that we get encoded SEXP - we should check ... */ ibuf += 1; res = QAP_decode(&ibuf); /* FIXME: Rserve has a bug(?) that sets CMD_RESP on OOB commands so we clear it for now ... */ hdr->cmd &= ~CMD_RESP; if (IS_OOB_SEND(hdr->cmd) && c->oob_send_cb) PROTECT(ee = lang3(c->oob_send_cb, ScalarInteger(OOB_USR_CODE(hdr->cmd)), res)); if (IS_OOB_MSG(hdr->cmd) && c->oob_msg_cb) PROTECT(ee = lang3(c->oob_msg_cb, ScalarInteger(OOB_USR_CODE(hdr->cmd)), res)); Rprintf(" - OOB %x %s (%d) %d\n", hdr->cmd, IS_OOB_SEND(hdr->cmd) ? "send" : "other", OOB_USR_CODE(hdr->cmd), (int) tl); if (ee != R_NilValue) { res = eval(ee, R_GlobalEnv); if (IS_OOB_MSG(hdr->cmd)) { struct phdr rhdr; long pl = QAP_getStorageSize(res); SEXP outv = allocVector(RAWSXP, pl); int isx = pl > 0x7fffff; unsigned int *oh = (unsigned int*) RAW(outv); unsigned int *ot = QAP_storeSEXP(oh + (isx ? 2 : 1), res, pl); pl = sizeof(int) * (long) (ot - oh); rhdr.cmd = hdr->cmd | CMD_RESP; rhdr.len = pl; rhdr.dof = 0; #ifdef __LP64__ rhdr.res = pl >> 32; #else rhdr.res = 0; #endif oh[0] = SET_PAR(DT_SEXP | (isx ? DT_LARGE : 0), pl - (isx ? 8 : 4)); if (isx) oh[1] = (pl - 8) >> 24; rsc_write(c, &rhdr, sizeof(rhdr)); if (pl) rsc_write(c, RAW(outv), pl); rsc_flush(c); } UNPROTECT(1); } UNPROTECT(1); continue; } break; } if (c->in_cmd) c->in_cmd--; if (hdr->cmd != RESP_OK) { rsc_slurp(c, tl); Rf_error("command failed with status code 0x%x: %s", CMD_STAT(hdr->cmd), rs_status_string(CMD_STAT(hdr->cmd))); } return tl; } SEXP RS_eval_qap(SEXP sc, SEXP what, SEXP sWait) { SEXP res = R_NilValue; rsconn_t *c; int async = (asInteger(sWait) == 0); if (!inherits(sc, "RserveConnection")) Rf_error("invalid connection"); c = (rsconn_t*) EXTPTR_PTR(sc); if (!c) Rf_error("invalid NULL connection"); if (!async && c->in_cmd) Rf_error("uncollected result from previous command, remove first"); { struct phdr rhdr; long pl = QAP_getStorageSize(what), tl; SEXP outv = allocVector(RAWSXP, pl); int isx = pl > 0x7fffff; unsigned int *oh = (unsigned int*) RAW(outv); unsigned int *ot = QAP_storeSEXP(oh + (isx ? 2 : 1), what, pl); pl = sizeof(int) * (long) (ot - oh); rhdr.cmd = CMD_eval; /* If the call is OCref then it's OCcall and not eval ... */ if (TYPEOF(what) == LANGSXP && inherits(CAR(what), "OCref")) rhdr.cmd = CMD_OCcall; rhdr.len = pl; rhdr.dof = 0; #ifdef __LP64__ rhdr.res = pl >> 32; #else rhdr.res = 0; #endif oh[0] = SET_PAR(DT_SEXP | (isx ? DT_LARGE : 0), pl - (isx ? 8 : 4)); if (isx) oh[1] = (pl - 8) >> 24; rsc_write(c, &rhdr, sizeof(rhdr)); if (pl) rsc_write(c, RAW(outv), pl); rsc_flush(c); if (async) { c->in_cmd++; return R_NilValue; } tl = get_hdr(sc, c, &rhdr); res = allocVector(RAWSXP, tl); if (rsc_read(c, RAW(res), tl) != tl) { RS_close(sc); Rf_error("read error reading payload of the eval result"); } else { unsigned int *ibuf = (unsigned int*) RAW(res); 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) Rf_error("invalid result type coming from eval"); ibuf += is_large + 1; PROTECT(res); res = QAP_decode(&ibuf); UNPROTECT(1); } } return res; } SEXP RS_eval(SEXP sc, SEXP what, SEXP sWait) { SEXP res; rsconn_t *c; struct phdr hdr; char *p = (char*) RAW(what); int pl = LENGTH(what), async = (asInteger(sWait) == 0); long tl; if (!inherits(sc, "RserveConnection")) Rf_error("invalid connection"); c = (rsconn_t*) EXTPTR_PTR(sc); if (!c) Rf_error("invalid NULL connection"); if (!async && c->in_cmd) Rf_error("uncollected result from previous command, remove first"); hdr.cmd = CMD_serEval; hdr.len = pl; hdr.dof = 0; hdr.res = 0; rsc_write(c, &hdr, sizeof(hdr)); rsc_write(c, p, pl); rsc_flush(c); if (async) { c->in_cmd++; return R_NilValue; } tl = get_hdr(sc, c, &hdr); res = allocVector(RAWSXP, tl); if (rsc_read(c, RAW(res), tl) != tl) { RS_close(sc); Rf_error("read error reading payload of the eval result"); } return res; } SEXP RS_collect(SEXP sc, SEXP s_timeout) { double tout = asReal(s_timeout); int maxfd = 0, r; fd_set rset; struct timeval tv; FD_ZERO(&rset); if (TYPEOF(sc) == VECSXP) { int n = LENGTH(sc), i; for (i = 0; i < n; i++) { SEXP cc = VECTOR_ELT(sc, i); if (TYPEOF(cc) == EXTPTRSXP && inherits(cc, "RserveConnection")) { rsconn_t *c = (rsconn_t*) EXTPTR_PTR(cc); if (c && (c->in_cmd) && c->s != -1) { if (c->s > maxfd) maxfd = c->s; FD_SET(c->s, &rset); } } } } else if (TYPEOF(sc) == EXTPTRSXP && inherits(sc, "RserveConnection")) { rsconn_t *c = (rsconn_t*) EXTPTR_PTR(sc); if (c && (c->in_cmd) && c->s != -1) { if (c->s > maxfd) maxfd = c->s; FD_SET(c->s, &rset); } } else Rf_error("invalid input - must be an Rserve connection or a list thereof"); if (maxfd == 0) return R_NilValue; if (tout < 0.0 || tout > 35000000.0) tout = 35000000.0; /* roughly a year .. */ tv.tv_sec = (int) tout; tv.tv_usec = (tout - (double) tv.tv_sec) * 1000000.0; r = select(maxfd + 1, &rset, 0, 0, &tv); if (r < 1) return R_NilValue; /* FIXME: we don't distinguish between error and timeout ... */ { SEXP res; struct phdr hdr; long tl; rsconn_t *c; int rdy = -1; if (TYPEOF(sc) == EXTPTRSXP) /* there is only one so it must be us */ c = (rsconn_t*) EXTPTR_PTR(sc); else { /* find a connection that is ready */ int n = LENGTH(sc), i; for (i = 0; i < n; i++) { SEXP cc = VECTOR_ELT(sc, i); if (TYPEOF(cc) == EXTPTRSXP && inherits(cc, "RserveConnection")) { c = (rsconn_t*) EXTPTR_PTR(cc); if (c && (c->in_cmd) && FD_ISSET(c->s, &rset)) break; } } if (i >= n) return R_NilValue; rdy = i; sc = VECTOR_ELT(sc, rdy); } /* both sc and c are set to the node and the structure */ tl = get_hdr(sc, c, &hdr); res = PROTECT(allocVector(RAWSXP, tl)); setAttrib(res, install("rsc"), sc); if (rdy >= 0) setAttrib(res, install("index"), ScalarInteger(rdy + 1)); if (rsc_read(c, RAW(res), tl) != tl) { RS_close(sc); Rf_error("read error reading payload of the eval result"); } UNPROTECT(1); return res; } } SEXP RS_assign(SEXP sc, SEXP what, SEXP sWait) { SEXP res; rsconn_t *c; struct phdr hdr; char *p = (char*) RAW(what); int pl = LENGTH(what), async = (asInteger(sWait) == 0); long tl; if (!inherits(sc, "RserveConnection")) Rf_error("invalid connection"); c = (rsconn_t*) EXTPTR_PTR(sc); if (!c) Rf_error("invalid NULL connection"); if (!async && c->in_cmd) Rf_error("uncollected result from previous command, remove first"); hdr.cmd = CMD_serAssign; hdr.len = pl; hdr.dof = 0; hdr.res = 0; rsc_write(c, &hdr, sizeof(hdr)); rsc_write(c, p, pl); rsc_flush(c); if (async) { c->in_cmd++; return R_NilValue; } tl = get_hdr(sc, c, &hdr); res = allocVector(RAWSXP, tl); if (rsc_read(c, RAW(res), tl) != tl) { RS_close(sc); Rf_error("read error reading payload of the eval result"); } return res; } SEXP RS_ctrl_str(SEXP sc, SEXP sCmd, SEXP sPayload) { rsconn_t *c; const char *pl; struct phdr hdr; int cmd = asInteger(sCmd), pll, par; long tl; if (!inherits(sc, "RserveConnection")) Rf_error("invalid connection"); c = (rsconn_t*) EXTPTR_PTR(sc); if (!c) Rf_error("invalid NULL connection"); if (c->in_cmd) Rf_error("uncollected result from previous command, remove first"); if (TYPEOF(sPayload) != STRSXP || LENGTH(sPayload) != 1) Rf_error("invalid control command payload - string expected"); pl = CHAR(STRING_ELT(sPayload, 0)); pll = strlen(pl); if ((cmd & (~ 0xf)) != CMD_ctrl) Rf_error("invalid command - must be a control command"); hdr.cmd = cmd; hdr.len = pll + 5; /* payload + header + NUL */ hdr.dof = 0; hdr.res = 0; rsc_write(c, &hdr, sizeof(hdr)); par = SET_PAR(DT_STRING, pll + 1); rsc_write(c, &par, sizeof(par)); rsc_write(c, pl, pll + 1); rsc_flush(c); tl = get_hdr(sc, c, &hdr); if (tl) { /* FIXME: we actually discard it so we could use slurp instead ..? */ SEXP res = allocVector(RAWSXP, tl); if (rsc_read(c, RAW(res), tl) != tl) { RS_close(sc); Rf_error("read error reading payload of the result"); } } if (CMD_FULL(hdr.cmd) == RESP_ERR) Rf_error("Rserve responded with an error code 0x%x: %s", CMD_STAT(hdr.cmd), rs_status_string(CMD_STAT(hdr.cmd))); else if (CMD_FULL(hdr.cmd) != RESP_OK) Rf_error("unknown response 0x%x", hdr.cmd); return ScalarLogical(TRUE); } SEXP RS_switch(SEXP sc, SEXP prot) { rsconn_t *c; if (!inherits(sc, "RserveConnection")) Rf_error("invalid connection"); c = (rsconn_t*) EXTPTR_PTR(sc); if (!c) Rf_error("invalid NULL connection"); if (c->in_cmd) Rf_error("uncollected result from previous command, remove first"); if (TYPEOF(prot) != STRSXP || LENGTH(prot) != 1) Rf_error("invalid protocol specification"); #ifdef USE_TLS if (!strcmp(CHAR(STRING_ELT(prot, 0)), "TLS")) { struct phdr hdr; int par; long tl; hdr.cmd = CMD_switch; hdr.len = 8; hdr.res = 0; hdr.dof = 0; par = SET_PAR(DT_STRING, 4); rsc_write(c, &hdr, sizeof(hdr)); rsc_write(c, &par, sizeof(par)); rsc_write(c, "TLS", 4); rsc_flush(c); tl = get_hdr(sc, c, &hdr); if (tl) rsc_slurp(c, tl); if (tls_upgrade(c) != 1) { RS_close(sc); Rf_error("TLS negotitation failed"); } return ScalarLogical(TRUE); } #endif Rf_error("unsupported protocol"); return R_NilValue; } SEXP RS_authkey(SEXP sc, SEXP type) { SEXP res; rsconn_t *c; struct phdr hdr; const char *key_type; int par; long tl; if (!inherits(sc, "RserveConnection")) Rf_error("invalid connection"); c = (rsconn_t*) EXTPTR_PTR(sc); if (!c) Rf_error("invalid NULL connection"); if (c->in_cmd) Rf_error("uncollected result from previous command, remove first"); if (TYPEOF(type) != STRSXP || LENGTH(type) != 1) Rf_error("invalid key type specification"); key_type = CHAR(STRING_ELT(type, 0)); hdr.cmd = CMD_keyReq; hdr.len = strlen(key_type) + 5; hdr.dof = 0; hdr.res = 0; par = SET_PAR(DT_STRING, strlen(key_type) + 1); rsc_write(c, &hdr, sizeof(hdr)); rsc_write(c, &par, sizeof(par)); rsc_write(c, key_type, strlen(key_type) + 1); rsc_flush(c); tl = get_hdr(sc, c, &hdr); res = allocVector(RAWSXP, tl); if (rsc_read(c, RAW(res), tl) != tl ) { RS_close(sc); Rf_error("read error loading key payload"); } return res; } static unsigned char secauth_buf[65536]; #ifdef USE_TLS static int RSA_encrypt(RSA *rsa, const unsigned char *src, unsigned char *dst, int len) { int i = 0, j = 0; while (len > 0) { int blk = (len > RSA_size(rsa) - 42) ? (RSA_size(rsa) - 42) : len; int eb = RSA_public_encrypt(blk, src + i, dst + j, rsa, RSA_PKCS1_OAEP_PADDING); if (eb < blk) return -1; i += blk; j += eb; len -= blk; } return j; } #endif SEXP RS_secauth(SEXP sc, SEXP auth, SEXP key) { #ifdef USE_TLS rsconn_t *c; struct phdr hdr; unsigned char *r; const unsigned char *ptr; int l, n, on, al, par; long tl; RSA *rsa; if (!inherits(sc, "RserveConnection")) Rf_error("invalid connection"); if (TYPEOF(key) != RAWSXP || LENGTH(key) < 16) Rf_error("invalid key"); c = (rsconn_t*) EXTPTR_PTR(sc); if (!c) Rf_error("invalid NULL connection"); if (c->in_cmd) Rf_error("uncollected result from previous command, remove first"); if (!((TYPEOF(auth) == STRSXP && LENGTH(auth) == 1) || (TYPEOF(auth) == RAWSXP))) Rf_error("invalid auhtentication token"); r = (unsigned char*) RAW(key); l = ((int) r[0]) | (((int) r[1]) << 8) | (((int) r[2]) << 16) | (((int) r[3]) << 24); if (l + 8 > LENGTH(key)) Rf_error("invalid key"); if (l > 17000) Rf_error("authkey is too big for this client"); n = ((int) r[l + 4]) | (((int) r[l + 5]) << 8) | (((int) r[l + 6]) << 16) | (((int) r[l + 7]) << 24); /* Rprintf("l = %d, n = %d, sum = %d (length %d)\n", l, n, l + n + 8, LENGTH(key)); */ if (l + n + 8 > LENGTH(key)) Rf_error("invalid key"); ptr = r + l + 8; if (first_tls) init_tls(); rsa = d2i_RSAPublicKey(0, &ptr, n); if (!rsa) Rf_error("the key has no valid RSA public key: %s", ERR_error_string(ERR_get_error(), 0)); memcpy(secauth_buf, r, l + 4); if (TYPEOF(auth) == STRSXP) { const char *ak = translateCharUTF8(STRING_ELT(auth, 0)); al = strlen(ak) + 1; if (al > 4096) Rf_error("too long authentication token"); memcpy(secauth_buf + l + 8, ak, al); } else { al = LENGTH(auth); if (al > 4096) Rf_error("too long authentication token"); memcpy(secauth_buf + l + 8, RAW(auth), al); } secauth_buf[l + 4] = al & 255; secauth_buf[l + 5] = (al >> 8) & 255; secauth_buf[l + 6] = (al >> 16) & 255; secauth_buf[l + 7] = (al >> 24) & 255; on = RSA_encrypt(rsa, secauth_buf, secauth_buf + 32768, l + al + 8); if (on < l + al + 8) Rf_error("failed to encrypt authentication packet (%s)", ERR_error_string(ERR_get_error(), 0)); hdr.cmd = CMD_secLogin; hdr.len = on + 4; hdr.res = 0; hdr.dof = 0; par = SET_PAR(DT_BYTESTREAM, on); rsc_write(c, &hdr, sizeof(hdr)); rsc_write(c, &par, sizeof(par)); rsc_write(c, secauth_buf + 32768, on); rsc_flush(c); tl = get_hdr(sc, c, &hdr); if (tl) rsc_slurp(c, tl); return ScalarLogical(TRUE); #else Rf_error("RSA is not supported in this build of the client - recompile with OpenSLL"); return R_NilValue; #endif } SEXP RS_oob_cb(SEXP sc, SEXP send_cb, SEXP msg_cb, SEXP query) { rsconn_t *c; SEXP res; int read_only = (asInteger(query) == 1); if (!inherits(sc, "RserveConnection")) Rf_error("invalid connection"); c = (rsconn_t*) EXTPTR_PTR(sc); if (!c) Rf_error("invalid NULL connection"); if (!read_only) { if (send_cb != c->oob_send_cb) { if (c->oob_send_cb != R_NilValue) R_ReleaseObject(c->oob_send_cb); c->oob_send_cb = send_cb; if (send_cb != R_NilValue) R_PreserveObject(send_cb); } if (msg_cb != c->oob_msg_cb) { if (c->oob_msg_cb != R_NilValue) R_ReleaseObject(c->oob_msg_cb); c->oob_msg_cb = msg_cb; if (msg_cb != R_NilValue) R_PreserveObject(msg_cb); } } PROTECT(res = Rf_mkNamed(VECSXP, (const char *[]) { "send", "msg", "" })); SET_VECTOR_ELT(res, 0, send_cb); SET_VECTOR_ELT(res, 1, msg_cb); UNPROTECT(1); return res; } SEXP RS_eq(SEXP s1, SEXP s2) { if (!inherits(s1, "RserveConnection") || !inherits(s2, "RserveConnection")) return ScalarLogical(FALSE); return ScalarLogical((EXTPTR_PTR(s1) == EXTPTR_PTR(s2)) ? TRUE : FALSE); } SEXP RS_print(SEXP sc) { rsconn_t *c; if (!inherits(sc, "RserveConnection")) Rf_error("invalid connection"); c = (rsconn_t*) EXTPTR_PTR(sc); if (!c) Rprintf(" **invalid** RserveConnection\n"); else if (c->s == -1) Rprintf(" Closed Rserve connection %p\n", c); else Rprintf(" Rserve %s connection %p (socket %d, queue length %d)\n", c->tls ? "TLS/QAP1" : "QAP1", c, c->s, c->in_cmd); return sc; } /* --- asynchronous API --- */ #ifdef USE_THREADS int rsc_handshake(rsconn_t *c) { char idstr[32]; if (rsc_read(c, idstr, 32) != 32) { if (c->thread) c->thread = ACS_HSERR; rsc_abort(c, "Handshake failed - ID string not received"); return -1; } if (memcmp(idstr, "Rsrv", 4) || memcmp(idstr + 8, "QAP1", 4)) { if (c->thread) c->thread = ACS_HSERR; rsc_abort(c, "Handshake failed - unknown protocol"); return -1; } /* supported range 0100 .. 0103 */ if (memcmp(idstr + 4, "0100", 4) < 0 || memcmp(idstr + 4, "0103", 4) > 0) { if (c->thread) c->thread = ACS_HSERR; rsc_abort(c, "Handshake failed - server protocol version too high"); return -1; } return 0; } static void *rsc_async_thread(void *par) { rsconn_t *c = (rsconn_t*) par; if (!c) return c; c = rsc_connect_ex(c->host, c->port, c); if (!c) return c; if (rsc_handshake(c)) return 0; return 0; } SEXP RS_connect_async(SEXP sHost, SEXP sPort, SEXP useTLS) { int port = asInteger(sPort), use_tls = (asInteger(useTLS) == 1); const char *host; rsconn_t *c; SEXP res; 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_alloc(); if (!c) Rf_error("cannot allocate memory"); c->host = strdup(host); c->port = port; c->thread = ACS_CONNECTING; if (sbthread_create(rsc_async_thread, c)) { rsc_close(c); Rf_error("cannot create thread for the connection"); } res = PROTECT(R_MakeExternalPtr(c, R_NilValue, R_NilValue)); setAttrib(res, R_ClassSymbol, mkString("RserveAsyncConnection")); R_RegisterCFinalizer(res, rsconn_fin); UNPROTECT(1); return res; } #endif RSclient/src/Makevars.win0000644000176000001440000000030412176747377015126 0ustar ripleyusersifeq ($(WIN),64) PKG_LIBS = -Lwin64 -lssl -lcrypto -lws2_32 -lgdi32 -lcrypt32 PKG_CPPFLAGS = -Iwin64 else PKG_LIBS = -Lwin32 -lssl -lcrypto -lws2_32 -lgdi32 -lcrypt32 PKG_CPPFLAGS = -Iwin32 endif RSclient/src/qap_decode.c0000644000176000001440000001633512176747400015064 0ustar ripleyusers#include "qap_decode.h" #include #include #define decode_to_SEXP QAP_decode /* string encoding handling */ #if (R_VERSION < R_Version(2,8,0)) || (defined DISABLE_ENCODING) #define mkRChar(X) mkChar(X) #else #define USE_ENCODING 1 extern cetype_t string_encoding; #define mkRChar(X) mkCharCE((X), string_encoding) #endif /* this is the representation of NAs in strings. We chose 0xff since that should never occur in UTF-8 strings. If 0xff occurs in the beginning of a string anyway, it will be doubled to avoid misrepresentation. */ static const unsigned char NaStringRepresentation[2] = { 255, 0 }; /* decode_toSEXP is used to decode SEXPs from binary form and create corresponding objects in R. UPC is a pointer to a counter of UNPROTECT calls which will be necessary after we're done. The buffer position is advanced to the point where the SEXP ends (more precisely it points to the next stored SEXP). */ SEXP decode_to_SEXP(unsigned int **buf) { unsigned int *b = *buf, *pab = *buf; char *c, *cc; SEXP val = 0, vatt = 0; int ty = PAR_TYPE(ptoi(*b)); rlen_t ln = PAR_LEN(ptoi(*b)); R_len_t i, l; if (IS_LARGE(ty)) { ty ^= XT_LARGE; b++; ln |= ((rlen_t) (unsigned int) ptoi(*b)) << 24; } #ifdef RSERV_DEBUG printf("decode: type=%d, len=%ld\n", ty, (long)ln); #endif b++; pab = b; /* pre-attr b */ if (ty & XT_HAS_ATTR) { #ifdef RSERV_DEBUG printf(" - has attributes\n"); #endif *buf = b; vatt = PROTECT(decode_to_SEXP(buf)); b = *buf; ty = ty ^ XT_HAS_ATTR; #ifdef RSERV_DEBUG printf(" - returned from attributes(@%p)\n", (void*)*buf); #endif ln -= (((char*)b) - ((char*)pab)); /* adjust length */ } /* b = beginning of the SEXP data (after attrs) pab = beginning before attrs (=just behind the heaer) ln = length of th SEX payload (w/o attr) */ switch(ty) { case XT_NULL: val = R_NilValue; *buf = b; break; case XT_INT: case XT_ARRAY_INT: l = ln / 4; val = allocVector(INTSXP, l); #ifdef NATIVE_COPY memcpy(INTEGER(val), b, l * sizeof(int)); b += l; #else i = 0; while (i < l) { INTEGER(val)[i] = ptoi(*b); i++; b++; } #endif *buf = b; break; case XT_ARRAY_BOOL: { int vl = ptoi(*(b++)); char *cb = (char*) b; val = allocVector(LGLSXP, vl); i = 0; while (i < vl) { LOGICAL(val)[i] = (cb[i] == 1) ? TRUE : ((cb[i] == 0) ? FALSE : NA_LOGICAL); i++; } while ((i & 3) != 0) i++; b = (unsigned int*) (cb + i); } *buf = b; break; case XT_DOUBLE: case XT_ARRAY_DOUBLE: l = ln / 8; val = allocVector(REALSXP, l); #ifdef NATIVE_COPY memcpy(REAL(val), b, sizeof(double) * l); b += l * 2; #else i = 0; while (i < l) { fixdcpy(REAL(val) + i, b); b += 2; i++; } #endif *buf = b; break; case XT_ARRAY_CPLX: l = ln / 16; val = allocVector(CPLXSXP, l); #ifdef NATIVE_COPY memcpy(COMPLEX(val), b, sizeof(*COMPLEX(val)) * l); b += l * 4; #else i = 0; while (i < l) { fixdcpy(&(COMPLEX(val)[i].r),b); b+=2; fixdcpy(&(COMPLEX(val)[i].i),b); b+=2; i++; } #endif *buf = b; break; case XT_ARRAY_STR: { /* count the number of elements */ char *sen = (c = (char*)(b)) + ln; i = 0; while (c < sen) { if (!*c) i++; c++; } /* protect so we can alloc CHARSXPs */ val = PROTECT(allocVector(STRSXP, i)); i = 0; cc = c = (char*)b; while (c < sen) { SEXP sx; if (!*c) { if ((unsigned char)cc[0] == NaStringRepresentation[0]) { if ((unsigned char)cc[1] == NaStringRepresentation[1]) sx = R_NaString; else sx = mkRChar(cc + 1); } else sx = mkRChar(cc); SET_STRING_ELT(val, i, sx); i++; cc = c + 1; } c++; } UNPROTECT(1); } *buf = (unsigned int*)((char*)b + ln); break; case XT_RAW: i = ptoi(*b); val = allocVector(RAWSXP, i); memcpy(RAW(val), (b + 1), i); *buf = (unsigned int*)((char*)b + ln); break; case XT_VECTOR: case XT_VECTOR_EXP: { unsigned char *ie = (unsigned char*) b + ln; R_len_t n = 0; SEXP lh = R_NilValue; SEXP vr = allocVector(VECSXP, 1); *buf = b; PROTECT(vr); while ((unsigned char*)*buf < ie) { SEXP v = decode_to_SEXP(buf); lh = CONS(v, lh); SET_VECTOR_ELT(vr, 0, lh); /* this is our way of staying protected .. maybe not optimal .. */ n++; } #ifdef RSERV_DEBUG printf(" vector (%s), %d elements\n", (ty == XT_VECTOR) ? "generic" : ((ty == XT_VECTOR_EXP) ? "expression" : "string"), n); #endif val = PROTECT(allocVector((ty==XT_VECTOR) ? VECSXP : ((ty == XT_VECTOR_EXP) ? EXPRSXP : STRSXP), n)); while (n > 0) { n--; SET_VECTOR_ELT(val, n, CAR(lh)); lh = CDR(lh); } #ifdef RSERV_DEBUG printf(" end of vector %lx/%lx\n", (long) *buf, (long) ie); #endif UNPROTECT(2); /* val and vr */ break; } case XT_STR: case XT_SYMNAME: /* i=ptoi(*b); b++; */ #ifdef RSERV_DEBUG printf(" string/symbol(%d) '%s'\n", ty, (char*)b); #endif { char *c = (char*) b; if (ty == XT_STR) { val = mkRChar(c); } else val = install(c); } *buf = (unsigned int*)((char*)b + ln); break; case XT_S4: val = Rf_allocS4Object(); break; case XT_LIST_NOTAG: case XT_LIST_TAG: case XT_LANG_NOTAG: case XT_LANG_TAG: { SEXP vnext = R_NilValue, vtail = 0; unsigned char *ie = (unsigned char*) b + ln; val = R_NilValue; *buf = b; while ((unsigned char*)*buf < ie) { #ifdef RSERV_DEBUG printf(" el %08lx of %08lx\n", (unsigned long)*buf, (unsigned long) ie); #endif SEXP el = PROTECT(decode_to_SEXP(buf)); SEXP ea = R_NilValue; if (ty == XT_LANG_TAG || ty==XT_LIST_TAG) { #ifdef RSERV_DEBUG printf(" tag %08lx of %08lx\n", (unsigned long)*buf, (unsigned long) ie); #endif ea = decode_to_SEXP(buf); if (ea != R_NilValue) PROTECT(ea); } if (ty == XT_LANG_TAG || ty == XT_LANG_NOTAG) vnext = LCONS(el, R_NilValue); else vnext = CONS(el, R_NilValue); PROTECT(vnext); if (ea != R_NilValue) SET_TAG(vnext, ea); if (vtail) { SETCDR(vtail, vnext); UNPROTECT((ea == R_NilValue) ? 2 : 3); } else { UNPROTECT((ea == R_NilValue) ? 2 : 3); PROTECT(val); /* protect the root */ val = vnext; } vtail = vnext; } if (vtail) UNPROTECT(1); break; } default: REprintf("Rserve SEXP parsing: unsupported type %d\n", ty); val = R_NilValue; *buf = (unsigned int*)((char*)b + ln); } if (vatt) { /* if vatt contains "class" we have to set the object bit [we could use classgets(vec,kls) instead] */ SEXP head = vatt; int has_class = 0; PROTECT(val); SET_ATTRIB(val, vatt); while (head != R_NilValue) { if (TAG(head) == R_ClassSymbol) { has_class = 1; break; } head = CDR(head); } if (has_class) /* if it has a class slot, we have to set the object bit */ SET_OBJECT(val, 1); #ifdef SET_S4_OBJECT /* FIXME: we have currently no way of knowing whether an object derived from a non-S4 type is actually S4 object. Hence we can only flag "pure" S4 objects */ if (TYPEOF(val) == S4SXP) SET_S4_OBJECT(val); #endif UNPROTECT(2); /* vatt + val */ } /* NOTE: val is NOT protected - this guarantees that recursion doesn't fill up the stack */ return val; } RSclient/src/qap_decode.h0000644000176000001440000000023412176747400015060 0ustar ripleyusers#ifndef QAP_DECODE_H__ #define QAP_DECODE_H__ /* this is a compatibility header so we can re-use Rserve/src/qap_decode.c as-is */ #include "qap.h" #endif RSclient/NAMESPACE0000644000176000001440000000066612176747377013301 0ustar ripleyusersuseDynLib(RSclient) # old client export(RSassign, RSattach, RSclose, RSconnect, RSdetach, RSeval, RSevalDetach, RSlogin, RSshutdown, RSserverEval, RSserverSource) # new client export(RS.connect, RS.eval, RS.eval.qap, RS.close, RS.switch, RS.authkey, RS.login, RS.collect, RS.assign, RS.oobCallbacks) export(RS.server.eval, RS.server.source, RS.server.shutdown) export(print.RserveConnection, "!=.RserveConnection", "==.RserveConnection") RSclient/NEWS0000644000176000001440000000257512176747377012562 0ustar ripleyusers0.7-2 2013-07-02 o add RS.eval(..., lazy=FALSE) which evaluates the argument locally and then remotely. This allows the construction of remote calls with both remote and local symbols. o add RS.eval.qap() which uses Rserve QAP encoding instead of native R serialization (requires Rserve 1.7-0 with DT_SEXP support in CMD_eval). o add support for Rserve object-capability (OC) model mode. OC calls are issued using RS.eval.qap() with OCref as the function to call. o switch the order of winsock2.h and windows.h 0.7-1 2013-02-19 o add support for asynchronous connections and OOB streaming o add support for non-transparent proxy protocol (RSpx) o allow queuing of asynchronous RS.eval() and RS.assign() o add basic methods for connections such as print, == and != o allow convenient RS.assign(c, x) syntax 0.7-0 2012-11-05 o initial CRAN release - the R client is based on Rserve 0.6-8 The function names on this old client are in the form RSxxx() Included is a new C-based client which uses sockets directly and thus supports features that cannot be supported with an R-based client such as TLS/SSL connections, switching, RSA secure authentication, multi-client selection. The function names for the new client are of the form RS.xxx() Handles of the two clients are not interchangeable, so you can only use one or the other for one connection. RSclient/R/0000755000176000001440000000000012176747400012236 5ustar ripleyusersRSclient/R/cli.R0000644000176000001440000000472012176747377013150 0ustar ripleyusersRS.connect <- function(host=NULL, port=6311L, tls=FALSE, proxy.target=NULL, proxy.wait=TRUE) .Call("RS_connect", host, port, tls, proxy.target, proxy.wait, PACKAGE="RSclient") RS.close <- function(rsc) .Call("RS_close", rsc) RS.eval <- function(rsc, x, wait=TRUE, lazy=TRUE) { r <- .Call("RS_eval", rsc, serialize(if (isTRUE(lazy)) substitute(x) else x, NULL, FALSE), wait, PACKAGE="RSclient"); if (is.raw(r)) unserialize(r) else r } RS.eval.qap <- function(rsc, x, wait=TRUE) .Call("RS_eval_qap", rsc, x, wait, PACKAGE="RSclient") RS.collect <- function(rsc, timeout = Inf, detail = FALSE) { r <- .Call("RS_collect", rsc, timeout, PACKAGE="RSclient") if (is.raw(r)) { if (length(r)) { if (isTRUE(detail)) list(value = unserialize(r), rsc = attr(r, "rsc")) else unserialize(r) } else if (isTRUE(detail)) list(rsc = attr(r, "rsc")) else NULL } else r } RS.server.eval <- function(rsc, text) .Call("RS_ctrl_str", rsc, 0x42L, text, PACKAGE="RSclient") RS.server.source <- function(rsc, filename) .Call("RS_ctrl_str", rsc, 0x45L, filename, PACKAGE="RSclient") RS.server.shutdown <- function(rsc) .Call("RS_ctrl_str", rsc, 0x44L, "", PACKAGE="RSclient") RS.switch <- function(rsc, protocol="TLS") .Call("RS_switch", rsc, protocol, PACKAGE="RSclient") RS.authkey <- function(rsc, type="rsa-authkey") .Call("RS_authkey", rsc, type, PACKAGE="RSclient") RS.assign <- function(rsc, name, value, wait = TRUE) { if (missing(value)) { sym.name <- deparse(substitute(name)) value <- name name <- sym.name } .Call("RS_assign", rsc, serialize(list(name, value), NULL), wait, PACKAGE="RSclient") } RS.login <- function(rsc, user, password, pubkey, authkey) { if (missing(user) || missing(password)) stop("user and password must be specified") .Call("RS_secauth", rsc, paste(c(user, password, ''), collapse="\n"), authkey, PACKAGE="RSclient") } RS.oobCallbacks <- function(rsc, send, msg) { if (missing(send) && missing(msg)) return(.Call("RS_oob_cb", rsc, NULL, NULL, TRUE)) if (missing(send) || missing(msg)) { l <- .Call("RS_oob_cb", rsc, NULL, NULL, TRUE, PACKAGE="RSclient") if (missing(send)) send <- l$send if (missing(msg)) msg <- l$msg } invisible(.Call("RS_oob_cb", rsc, send, msg, FALSE, PACKAGE="RSclient")) } print.RserveConnection <- function(x, ...) invisible(.Call("RS_print", x)) `==.RserveConnection` <- function(e1, e2) .Call("RS_eq", e1, e2) `!=.RserveConnection` <- function(e1, e2) !.Call("RS_eq", e1, e2) RSclient/R/conn.R0000644000176000001440000001251112176747377013333 0ustar ripleyusersRSconnect <- function(host="localhost", port=6311) { c <- socketConnection(host,port,open="a+b",blocking=TRUE) a <- readBin(c,"raw",32) if (!length(a)) { close(c); stop("Attempt to connect to Rserve timed out, connection closed") } if (length(a) != 32 || !length(grep("^Rsrv01..QAP1",rawToChar(a)))) stop("Invalid response from Rserve") return( c ) } RSeval <- function(c, expr) { r <- if (is.character(expr)) serialize(parse(text=paste("{",paste(expr,collapse="\n"),"}"))[[1]],NULL) else serialize(expr, NULL) writeBin(c(0xf5L, length(r), 0L, 0L), c, endian="little") writeBin(r, c) b <- readBin(c,"int",4,endian="little") if (length(b)<4 || b[1] != 65537L) stop("remote evaluation failed") unserialize(readBin(c,"raw",b[2])) } RSassign <- function (c, obj, name = deparse(substitute(obj))) { r <- serialize(list(name, obj), NULL) writeBin(c(0xf6L,length(r),0L,0L), c, endian="little") writeBin(r, c) b <- readBin(c,"int",4,endian="little") if (length(b)<4 || b[1] != 65537L) stop("remote assign failed") invisible(obj) } RSclose <- function(c) close(c) # convert an array of unsigned integers into raw verctor safely # by converting 16-bits at a time .safe.int <- function(data) { r <- raw(length(data) * 4) j <- 1 for (i in data) { hi <- as.integer(i / 0x10000 + 0.5) lo <- as.integer( (i - hi*0x10000) + 0.5) rs <- writeBin(c(lo, hi), raw(), endian="little") r[j] <- rs[1] r[j+1] <- rs[2] r[j+2] <- rs[5] r[j+3] <- rs[6] j <- j + 4 } r } RSdetach <- function( c ) RSevalDetach( c, "" ) RSevalDetach <- function( c, cmd="" ) { # retrieve the host name from the connection (possibly unsafe!) host <- substr(strsplit(summary(c)$description,":")[[1]][1],3,999) if ( cmd != "" ) { r <- paste("serialize({", cmd[1], "},NULL)") l <- nchar(r[1])+1 writeBin(as.integer(c(0x031,l+4,0,0,4+l*256)), c, endian="little") writeBin(as.character(r[1]), c) b <- readBin(c,"int",4,endian="little") if (b[1]%%256 == 2 || b[2] < 12) stop("Eval/detach failed with error: ",b[1]%/%0x1000000) ## We don't need "isLarge" because we never get large data back } else { l <- 0 writeBin(as.integer(c(0x030,l+4,0,0,4+l*256)), c, endian="little") b <- readBin(c,"int",4,endian="little") if (b[1]%%256 != 1) stop("Detach failed with error: ",b[1]%/%0x1000000) } msgLen <- b[1]%/%256 a <- readBin(c,"int",2,signed=FALSE,endian="little") if (!length(a)) { close(c); stop("Rserve connection timed out and closed") } ## a[1] is DT_INT, a[2] is the payload (port#) port <- a[ 2 ] readBin(c,"raw",4) ## this should be DT_BYTESTREAM key <- readBin(c,"raw",msgLen-12) RSclose(c) list( port=port, key=key, host=host ) } RSattach <- function(session) { c <- socketConnection(session$host,session$port,open="a+b",blocking=TRUE) writeBin( session$key, c ) b <- readBin(c,"int",4,endian="little") if (!length(b)) { close(c); stop("Rserve connection timed out and closed") } if (b[1]%%256 != 1) stop("Attach failed with error: ",b[1]%/%0x1000000) c } RSlogin <- function(c, user, pwd, silent=FALSE) { r <- paste(user,pwd,sep="\n") l <- nchar(r[1])+1 writeBin(as.integer(c(1,l+4,0,0,4+l*256)), c, endian="little") writeBin(as.character(r[1]), c) b <- readBin(c,"int",4,endian="little") if (!length(b)) { close(c); stop("Rserve connection timed out and closed") } ##cat("header: ",b[1],", ",b[2],"\n") msgLen <- b[2] if (msgLen > 0) a <- readBin(c,"raw",msgLen) if (b[1]%%256 != 1 && !silent) stop("Login failed with error: ",b[1]%/%0x1000000) invisible(b[1]%%256 == 1) } RSserverEval <- function(c, expr) { if (is.language(expr)) expr <- deparse(expr) if (!is.character(expr)) stop("expr must me a character vector, name, call or an expression") r <- charToRaw(paste(expr,collapse='\n')) l <- length(r) + 1L writeBin(as.integer(c(0x42L, l + 4L,0L ,0L ,4L + l * 256L)), c, endian="little") writeBin(r, c) writeBin(raw(1), c) b <- readBin(c, "int", 4, endian="little") if (!length(b)) { close(c); stop("Rserve connection timed out and closed") } msgLen <- b[2] if (msgLen > 0) a <- readBin(c,"raw",msgLen) if (b[1]%%256 != 1) stop("RSserverEval failed with error: ",b[1]%/%0x1000000) invisible(b[1]%%256 == 1) } RSserverSource <- function(c, file) { if (!is.character(file) || length(file) != 1) stop("`file' must be a string") r <- charToRaw(file) l <- length(r) + 1L writeBin(as.integer(c(0x45L, l + 4L,0L ,0L ,4L + l * 256L)), c, endian="little") writeBin(r, c) writeBin(raw(1), c) b <- readBin(c, "int", 4, endian="little") if (!length(b)) { close(c); stop("Rserve connection timed out and closed") } msgLen <- b[2] if (msgLen > 0) a <- readBin(c,"raw",msgLen) if (b[1]%%256 != 1) stop("RSserverSource failed with error: ",b[1]%/%0x1000000) invisible(b[1]%%256 == 1) } RSshutdown <- function(c, pwd=NULL, ctrl=FALSE) { if (ctrl) { writeBin(c(0x44L, 0L, 0L, 0L), c, endian="little") b <- readBin(c, "int", 4, endian="little") if (!length(b)) { close(c); stop("Rserve connection timed out and closed") } msgLen <- b[2] if (msgLen > 0) a <- readBin(c,"raw",msgLen) if (b[1]%%256 != 1) stop("ctrlShutdown failed with error: ",b[1]%/%0x1000000) invisible(b[1]%%256 == 1) } else { # FIXME: we ignore pwd and don't check error status writeBin(as.integer(c(4, 0, 0, 0)), c, endian="little") } } RSclient/MD50000644000176000001440000000157112176765035012355 0ustar ripleyusers8eb5a7ac184c05fa0c84df5690a62471 *DESCRIPTION 09d68d6181bd117fc2e6e78962515b4d *LICENSE 254fec9664aae8681734cb89c6575dbc *NAMESPACE 7454e4b62b905f47981536387a23272a *NEWS 8d815e17f8852a8cdf5b2c5aba41b22e *R/cli.R 850e51c443e01c2c378065d9c8239667 *R/conn.R a0d9bc9f205fc694b10f962a55384a55 *configure.win 075456727b2e642b3942d9c129c4123e *man/RC-methods.Rd 35477c8e5001383cbcd73d5d06984c2a *man/RCC.Rd 86e5f13a97da7d3311703559ddffbe0e *man/Rclient.Rd ed7bc6eaee8b2524182dcf1647da8a8e *src/Makevars 31e24ed30aca5770049f49f2826f40ef *src/Makevars.win 3eb8be8db486565d2b0ab71ff14e7dc3 *src/RSprotocol.h 6dd729bd8a2512bb62dbcb7b98bc3cb4 *src/cli.c 18fe04a990f3a92ec9278686af92f459 *src/qap.h ed50225ffc871ea75203c241e3f7b32f *src/qap_decode.c ff4d7238f0a17ac5f1ae8f069dd58388 *src/qap_decode.h e50522d7b2c1972cd4283dbedf5a6430 *src/qap_encode.c 2b67cfab4cfa47e967cbb6dd5b6ca547 *src/sbthread.h RSclient/DESCRIPTION0000644000176000001440000000072312176765035013551 0ustar ripleyusersPackage: RSclient Version: 0.7-2 Title: Client for Rserve Author: Simon Urbanek Maintainer: Simon Urbanek Depends: R (>= 2.7.0) Description: Client for Rserve, allowing to connect to Rserve instances and issue commands. License: GPL-2 | file LICENSE URL: http://www.rforge.net/RSclient/ Packaged: 2013-08-02 15:23:44 UTC; svnuser NeedsCompilation: yes Repository: CRAN Date/Publication: 2013-08-02 19:19:25 RSclient/man/0000755000176000001440000000000012176747400012610 5ustar ripleyusersRSclient/man/RCC.Rd0000644000176000001440000002411512176747377013526 0ustar ripleyusers\name{RCC} \title{Functions to talk to an Rserve instance (new version)} \alias{RCC} \alias{RS.connect} \alias{RS.close} \alias{RS.eval} \alias{RS.eval.qap} \alias{RS.login} \alias{RS.switch} \alias{RS.authkey} \alias{RS.collect} \alias{RS.assign} \alias{RS.oobCallbacks} %\alias{RSdetach} %\alias{RSevalDetach} %\alias{RSattach} \alias{RS.server.shutdown} \alias{RS.server.eval} \alias{RS.server.source} \usage{ RS.connect(host = NULL, port = 6311L, tls = FALSE, proxy.target = NULL, proxy.wait = TRUE) RS.login(rsc, user, password, pubkey, authkey) RS.eval(rsc, x, wait = TRUE, lazy = TRUE) RS.eval.qap(rsc, x, wait = TRUE) RS.collect(rsc, timeout = Inf, detail = FALSE) RS.close(rsc) RS.assign(rsc, name, value, wait = TRUE) RS.switch(rsc, protocol = "TLS") RS.authkey(rsc, type = "rsa-authkey") RS.server.eval(rsc, text) RS.server.source(rsc, filename) RS.server.shutdown(rsc) RS.oobCallbacks(rsc, send, msg) } \description{ Rserve is a server providing R functionality via sockets. The following functions allow another R session to start new Rserve sessions and evaluate commands. } \note{ The current version of the \code{RSclient} package supplies two clients - one documented in \code{\link{Rclient}} which uses R connections and one documented in \code{\link{RCC}} which uses C code and is far more versatile and efficient. This is the documentation for the latter which is new and supports features that are not supported by R such as unix sockets, SSL/TLS connections, protocol switching, secure authentication and multi-server collection. } \arguments{ \item{host}{host to connect to or socket path or \code{NULL} for local host} \item{port}{TCP port to connect to or 0 if unix socket is to be used} \item{tls}{if \code{TRUE} then SSL/TLS encrypted connection is started} \item{proxy.target}{proxy target (string) in the form \code{:} to be used when connecting to a non-transparent proxy that requires target designation. Not used when connected to transparent proxies or directly to Rserve instances. Note that literal IPv6 addresses must be quoted in \code{[]}.} \item{proxy.wait}{if \code{TRUE} then the proxy will wait (indefinitely) if the target is unavailable due to too high load, if \code{FALSE} then the proxy is instructed to close the connection in such instance instead} \item{rsc}{Rserve connection as obtained from \code{RS.connect}} \item{user}{username for authentication (mandatory)} \item{password}{password for authentication} \item{pubkey}{public key for authentication} \item{authkey}{authkey (as obtained from \code{RS.authkey}) for secure authentication} \item{x}{expression to evaluate} \item{wait}{if \code{TRUE} then the result is delivered synchronously, if \code{FALSE} then \code{NULL} is returned instead and the result can be collected later with \code{RS.collect}} \item{lazy}{if \code{TRUE} then the passed expression is not evaluated locally but passed for remote evaluation (as if quoted, modulo substitution). Otherwise it is evaluated locally first and the result is passed for remote evaluation.} \item{timeout}{numeric, timeout (in seconds) to wait before giving up} \item{detail}{if \code{TRUE} then the result payload is returned in a list with elements \code{value} (unserialized result value of the command - where applicable) and \code{rsc} (connection which returned this result) which allows to identify the source of the result and to distinguish timeout from a \code{NULL} value. Otherwise the returned value is just the payload value of the result.} \item{name}{string, name of the symbol to assign to} \item{value}{value to assign -- if missing \code{name} is assumed to be a symbol and its evaluated value will be used as value while the symbol name will be used as name} \item{protocol}{protocol to switch to (string)} \item{type}{type of the authentication to perform (string)} \item{send}{callback function for \code{OOB_SEND}} \item{msg}{callback function for \code{OOB_MSG}} \item{text}{string that will be parsed and evaluated on the server side} \item{filename}{name of the file (on the server!) to source} } \details{ \code{RS.connect} creates a connection to a Rserve. The returned handle is to be used in all subsequent calls to client functions. The session associated witht he connection is alive until closed via \code{RS.close}. \code{RS.close} closes the Rserve connection. \code{RS.login} performs authentication with the Rserve. The \code{user} entry is mandatory and at least one of \code{password}, \code{pubkey} and \code{authkey} must be provided. Typical secure authentication is performed with \code{RS.login(rsc, "username", "password", authkey=RS.authkey(rsc))} which ensures that the authentication request is encrypted and cannot be spoofed. When using TLS connections \code{RS.authkey} is not necessary as the connection is already encrypted. \code{RS.eval} evaluates the supplied expression remotely. \code{RS.eval.qap} behaves like \code{RS.eval(..., lazy=FALSE)}, but uses the Rserve QAP serialization of R objects instead of the native R serialization. \code{RS.collect} collects results from \code{RS.eval(..., wait = FALSE)} calls. Note that in this case \code{rsc} can be either one connection or a list of connections. \code{RS.assign} assigns a value to the remote global workspace. \code{RS.switch} attempts to switch the protocol currently used for communication with Rserve. Currently the only supported protocol switch is from plain QAP1 to TLS secured (encrypted) QAP1. \code{RS.oobCallbacks} sets or retrieves the callback functions associated with \code{OOB_SEND} and \code{OOB_MSG} out-of-band commands. If neither \code{send} nor \code{msg} is specified then \code{RS.oobCallbacks} simply returns the current callback functions, otherwise it replaces the existing ones. Both functions have the form \code{function(code, payload)} where \code{code} is the OOB sub-code (scalar integer) and \code{payload} is the content passed in the OOB command. For \code{OOB_SEND} the result of the callback is disarded, for \code{OOB_MSG} the result is encoded and sent back to the server. Note that OOB commands in this client are only processed when waiting for the response to another command (typically \code{RS.eval}). OOB commands must be explicitly enabled in the server in order to be used (they are disabled by default). \code{RS.server.eval}, \code{RS.server.source} and \code{RS.server.shutdown} are `control commands' which are enqueued to be processed by the server asynchronously. They return \code{TRUE} on success which means the command was enqueued - it does not mean that the server has processed the command. All control commands affect only future connections, they do NOT affect any already established client connection (including the curretn one). \code{RS.server.eval} parses and evaluates the given code in the server instance, \code{RS.server.source} sources the given file in the server (the path is interpreted by the server, it is not the local path of the client!) and \code{RS.server.shutdown} attempts a clean shutdown of the server. Note that control commands are disabled by default and must be enabled in Rserve either in the configuration file with \code{control enable} or on the command line with \code{--RS-enable-control} (the latter only works with Rserve 1.7 and higher). If Rserve is configured with authentication enabled then only admin users can issues control commands (see Rserve documentation for details). } \examples{ \dontrun{ c <- RS.connect() RS.eval(c, data(stackloss)) RS.eval(c, library(MASS)) RS.eval(c, rlm(stack.loss ~ ., stackloss)$coeff) RS.eval(c, getwd()) x <- rnorm(1e5) ## this sends the contents of x to the remote side and runs `sum` on ## it without actually creating the binding x on the remote side RS.eval(c, as.call(list(quote(sum), x)), lazy=FALSE) RS.close(c) } } \author{Simon Urbanek} \section{Parallel use}{ It is currently possible to use Rserve connections in parallel via \code{mcparallel} or \code{mclapply} if certain conditions are met. First, only clear connection (non-TLS) are eligible for parallel use and there may be no OOB commands. Then it is legal to use connections in forked process as long as both the request is sent and the result is collected in the same process while no other process uses the connection. However, connections can only be created in the parent session (except if the connection is created and subsequently closed in the child process). One possible use is to initiate connections to a cluster and perform operations in parallel. For example: \preformatted{ library(RSclient) library(parallel) ## try to connect to 50 different nodes ## cannot parallelize this - must be in the parent process c <- lapply(paste("machine", 1:50, sep=''), function(name) try(RS.connect(name), silent=TRUE)) ## keep only successful connections c <- c[sapply(c, class) == "RserveConnection"] ## login to all machines in parallel (using RSA secured login) unlist(mclapply(c, function(c) RS.login(c, "user", "password",, RS.authkey(c)), mc.cores=length(c))) ## do parallel work ... ## pre-load some "job" function to all nodes unlist(mclapply(c, function(c) RS.assign(c, job), mc.cores=length(c))) ## etc. etc. then call it in parallel on all nodes ... mclapply(c, function(c) RS.eval(c, job()), mc.cores=length(c)) ## close all sapply(c, RS.close) } } \note{ The RSclient package can be compiled with TLS/SSL support based on OpenSSL. Therefore the following statements may be true if RSclient binaries are shipped together with OpenSSL: This product includes software developed by the OpenSSL Project for use in the OpenSSL Toolkit (http://www.openssl.org/). This product includes cryptographic software written by Eric Young (eay@cryptsoft.com). This product includes software written by Tim Hudson (tjh@cryptsoft.com). They are not true otherwise. } \keyword{interface} RSclient/man/RC-methods.Rd0000644000176000001440000000136112176747377015062 0ustar ripleyusers\name{RC-methods} \alias{RC-methods} \alias{print.RserveConnection} \alias{==.RserveConnection} \alias{!=.RserveConnection} \title{ Methods for the RserveConnection class } \description{ Basic methods (printing, comparison) for the RserveConnection class. } \usage{ \S3method{print}{RserveConnection}(x, ...) \S3method{==}{RserveConnection}(e1, e2) \S3method{!=}{RserveConnection}(e1, e2) } \arguments{ \item{x}{Rserve connection object} \item{e1}{Rserve connection object} \item{e2}{Rserve connection object} \item{\dots}{ignored} } %\details{ %} \value{ \code{print} returns \code{x} invisibly \code{==} and \code{!=} return a logical scalar } %\references{ %} \author{ Simon Urbanek } %\note{ %} %\examples{ %} \keyword{interface} RSclient/man/Rclient.Rd0000644000176000001440000001363612176747377014525 0ustar ripleyusers\name{Rclient} \title{Functions to talk to an Rserve} \alias{Rclient} \alias{RSconnect} \alias{RSclose} \alias{RSeval} \alias{RSlogin} \alias{RSdetach} \alias{RSevalDetach} \alias{RSattach} \alias{RSassign} \alias{RSshutdown} \alias{RSserverEval} \alias{RSserverSource} \usage{ RSconnect(host = "localhost", port = 6311) RSlogin(c, user, pwd, silent = FALSE) RSeval(c, expr) RSclose(c) RSshutdown(c, pwd = NULL, ctrl = FALSE) RSdetach(c) RSevalDetach(c, cmd = "") RSattach(session) RSassign(c, obj, name = deparse(substitute(obj)) ) RSserverEval(c, expr) RSserverSource(c, file) } \description{ Rserve is a server providing R functionality via sockets. The following functions allow another R session to start new Rserve sessions and evaluate commands. The support is very rudimentary and uses only a fraction of the funtionality provided by Rserve. The typical use of Rserve is to connect to other applications, not necessarily to connect two R processes. However, it is not uncommon to have a cluster of Rserve machines so the following functions provide a simple client access. For more complete cilent implementation see \code{src/clients} directory of the Rserve distribution which show a C/C++ client. Also available from the Rserve pages is a Java client (\code{JRclient}). See \code{http://rosuda.org/Rserve} for details. } \arguments{ \item{host}{host to connect to} \item{port}{TCP port to connect to} \item{c}{Rserve connection} \item{user}{username for authentication} \item{pwd}{password for authentication} \item{cmd}{command (as string) to evaluate} \item{silent}{flag indicating whether a failure should raise an error or not} \item{session}{session object as returned by \code{RSdetach} or \code{RSevalDetach}} \item{obj}{value to assign} \item{name}{name to assign to on the remote side} \item{expr}{R expression to evaluate remotely} \item{file}{path to a file on the server(!) that will be sourced into the main instance} \item{ctrl}{logical, if \code{TRUE} then control command (\code{CMD_ctrlShutdown}) is used for shutdown, otherwise the legacy \code{CMD_shutdown} is used instead.} } \details{ \code{RSconnect} creates a connection to a Rserve. The returned handle is to be used in all subsequent calls to client functions. The session associated witht he connection is alive until closed via \code{RSclose}. \code{RSlogin} performs authentication with the Rserve. Currently this simple client supports only plain text authentication, encryption is not supported. \code{RSclose} closes the Rserve connection. \code{RSeval} evaluates the supplied expression remotely. \code{expr} can be either a string or any R expression. Use \code{\link{quote}} to use unevaluated expressions. The implementation of \code{RSeval} is very efficient in that it does not require any buffer on the remote side and uses native R serialization as the protocol. See exmples below for correct use. \code{RSdetach} detaches from the current Rserve connection. The connection is closed but can be restored by using \code{RSattach} with the value returned by \code{RSdetach}. Technically the R on the other end is still running and waiting to be atached. \code{RSshutdown} terminates the server gracefully. It should be immediately followed by \code{RSclose} since the server closes the connection. It can be issued only on a valid (authenticated) connection. The password parameter is currently ignored since password-protected shutdown is not yet supported. Please note that you should not terminate servers that you did not start. More recent Rserve installation can disable regular shutdown and only allow control shutdown (avaiable to control users only) which is invoked by specifying \code{ctrl=TRUE}. \code{RSevalDetach} same as \code{RSdetach} but allows asynchronous evaluation of the command. The remote Rserve is instructed to evaluate the command after the connection is detached. Please note that the session cannot be attached until the evaluation finished. Therefore it is advisable to use another session when attaching to verify the status of the detached session where necessary. \code{RSattach} resume connection to an existing session in Rserve. The \code{session} argument must have been previously returned from the \code{RSdetach} or \code{RSevalDetach} comment. \code{RSassign} pushes an object to Rserve and assigns it to the given name. Note that the name can be an (unevaluated) R expression itself thus allowing constructs such as \code{RSassign(c, 1:5, quote(a$foo))} which will result in \code{a$foo <- 1:5} remotely. However, character names are interpreted literarly. \code{RSserverEval} and \code{RSserverSource} enqueue commands in the server instance of Rserve, i.e. their effect will be visible for all subsequent client connections. The Rserve instance must have control commands enabled (not the default) in order to allow those commands. \code{RSserverEval} evaluates the supplied expression and \code{RSserverSource} sources the specified file - it must be a valid path to a file on the server, not the client machine! Both commands are executed asynchronously in the server, so the success of those commands only means that they were queued on the server - they will be executed between subsequent client connections. Note that only subsequent connections will be affected, not the one issuing those commands. } \examples{ \dontrun{ c <- RSconnect() data(stackloss) RSassign(c, stackloss) RSeval(c, quote(library(MASS))) RSeval(c, quote(rlm(stack.loss ~ ., stackloss)$coeff)) RSeval(c, "getwd()") image <- RSeval(c, quote(try({ attach(stackloss) library(Cairo) Cairo(file="plot.png") plot(Air.Flow,stack.loss,col=2,pch=19,cex=2) dev.off() readBin("plot.png", "raw", 999999)}))) if (inherits(image, "try-error")) stop(image) } } \author{Simon Urbanek} \keyword{interface} RSclient/configure.win0000644000176000001440000000273212176747377014556 0ustar ripleyusers#!/bin/sh echo " checking openssl headers and libraries" allok=yes if [ -e "${LOCAL_SOFT}/include/openssl/ssl.h" ]; then echo " --- Using local version of openssl found in LOCAL_SOFT: ${LOCAL_SOFT}" echo " --- Proceed at your own risk, if in doubt unset LOCAL_SOFT to use our binary." exit 0 fi if [ ! -e src/win32/libssl.a ]; then if [ ! -e src/openssl-current-win.tar.gz ]; then echo " cannot find current openssl files" echo " attempting to download them" echo 'download.file("http://www.rforge.net/PKI/files/openssl-current-win.tar.gz","src/openssl-current-win.tar.gz",mode="wb",quiet=TRUE)'|${R_HOME}/bin/R --vanilla --slave fi if [ ! -e src/openssl-current-win.tar.gz ]; then allok=no else echo " unpacking current openssl" tar fxz src/openssl-current-win.tar.gz -C src if [ ! -e src/win32/libssl.a ]; then allok=no fi fi fi if [ ! -e src/win32/libssl.a ]; then allok=no fi if [ ${allok} != yes ]; then echo "" echo " *** ERROR: unable to find openssl files" echo "" echo " They must be either in src/win32 or in a tar-ball" echo " src/openssl-current-win.tar.gz" echo "" echo " You can get the latest binary tar ball from" echo " http://www.rforge.net/PKI/files/" echo "" echo " Alternatively you can set LOCAL_SOFT environment variable" echo " to point to the prefix (like /usr/local) containing openssl binaries." echo "" exit 1 fi echo " seems ok, ready to go" exit 0 RSclient/LICENSE0000644000176000001440000004073012176747377013063 0ustar ripleyusers [Summary: GPL-2 with OpenSSL linking exception] RSclient Copyright (C) 2002-2013 Simon Urbanek This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; version 2 of the License. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. In addition, as a special exception, the copyright holders give permission to link the code of portions of this program with the OpenSSL project's "OpenSSL" library (or with modified versions of it that use the same license as the "OpenSSL" library - see http://www.openssl.org/), and distribute linked combinations including the two. You must obey the GNU General Public License in all respects for all of the code used other than OpenSSL. If you modify file(s) with this exception, you may extend this exception to your version of the file(s), but you are not obligated to do so. If you do not wish to do so, delete this exception statement from your version. If you delete this exception statement from all source files in the program, then also delete it here. Full text of GPL-2 follows: GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS