PageRenderTime 92ms CodeModel.GetById 21ms app.highlight 65ms RepoModel.GetById 1ms app.codeStats 0ms

/src/interface.cpp

https://github.com/brotchie/rzmq
C++ | 790 lines | 656 code | 107 blank | 27 comment | 151 complexity | aea4794e6672a53340710cdbab62a508 MD5 | raw file
  1///////////////////////////////////////////////////////////////////////////
  2// Copyright (C) 2011  Whit Armstrong                                    //
  3//                                                                       //
  4// This program is free software: you can redistribute it and/or modify  //
  5// it under the terms of the GNU General Public License as published by  //
  6// the Free Software Foundation, either version 3 of the License, or     //
  7// (at your option) any later version.                                   //
  8//                                                                       //
  9// This program is distributed in the hope that it will be useful,       //
 10// but WITHOUT ANY WARRANTY; without even the implied warranty of        //
 11// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         //
 12// GNU General Public License for more details.                          //
 13//                                                                       //
 14// You should have received a copy of the GNU General Public License     //
 15// along with this program.  If not, see <http://www.gnu.org/licenses/>. //
 16///////////////////////////////////////////////////////////////////////////
 17
 18#include <stdint.h>
 19#include <string>
 20#include <stdexcept>
 21#include <zmq.hpp>
 22#include "interface.h"
 23
 24int string_to_socket_type(const std::string s) {
 25  if(s == "ZMQ_PAIR") {
 26    return ZMQ_PAIR;
 27  } else if(s == "ZMQ_PUB") {
 28    return ZMQ_PUB;
 29  } else if(s == "ZMQ_SUB") {
 30    return ZMQ_SUB;
 31  } else if(s == "ZMQ_REQ") {
 32    return ZMQ_REQ;
 33  } else if(s == "ZMQ_REP") {
 34    return ZMQ_REP;
 35  } else if(s == "ZMQ_DEALER") {
 36    return ZMQ_DEALER;
 37  } else if(s == "ZMQ_ROUTER") {
 38    return ZMQ_ROUTER;
 39  } else if(s == "ZMQ_PULL") {
 40    return ZMQ_PULL;
 41  } else if(s == "ZMQ_PUSH") {
 42    return ZMQ_PUSH;
 43  } else if(s == "ZMQ_XPUB") {
 44    return ZMQ_XPUB;
 45  } else if(s == "ZMQ_XSUB") {
 46    return ZMQ_XSUB;
 47  } else {
 48    return -1;
 49  }
 50}
 51
 52void* checkExternalPointer(SEXP xp_, const char* valid_tag) {
 53  if(xp_ == R_NilValue) {
 54    throw std::logic_error("External pointer is NULL.");
 55  }
 56  if(TYPEOF(xp_) != EXTPTRSXP) {
 57    throw std::logic_error("Not an external pointer.");
 58  }
 59
 60  if(R_ExternalPtrTag(xp_)==R_NilValue) {
 61    throw std::logic_error("External pointer tag is NULL.");
 62  }
 63  const char* xp_tag = CHAR(PRINTNAME(R_ExternalPtrTag(xp_)));
 64  if(!xp_tag) {
 65    throw std::logic_error("External pointer tag is blank.");
 66  }
 67  if(strcmp(xp_tag,valid_tag) != 0) {
 68    throw std::logic_error("External pointer tag does not match.");
 69  }
 70  if(R_ExternalPtrAddr(xp_)==NULL) {
 71    throw std::logic_error("External pointer address is null.");
 72  }
 73  return R_ExternalPtrAddr(xp_);
 74}
 75
 76static void contextFinalizer(SEXP context_) {
 77  zmq::context_t* context = reinterpret_cast<zmq::context_t*>(R_ExternalPtrAddr(context_));
 78  if(context) {
 79    delete context;
 80    R_ClearExternalPtr(context_);
 81  }
 82}
 83
 84static void socketFinalizer(SEXP socket_) {
 85  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
 86  if(socket) {
 87    delete socket;
 88    R_ClearExternalPtr(socket_);
 89  }
 90}
 91
 92SEXP initContext() {
 93  SEXP context_;
 94  zmq::context_t* context = new zmq::context_t(1);
 95  if(context) {
 96    PROTECT(context_ = R_MakeExternalPtr(reinterpret_cast<void*>(context),install("zmq::context_t*"),R_NilValue));
 97    R_RegisterCFinalizerEx(context_, contextFinalizer, TRUE);
 98    UNPROTECT(1);
 99    return context_;
100  } else {
101    return R_NilValue;
102  }
103}
104
105SEXP initSocket(SEXP context_, SEXP socket_type_) {
106  SEXP socket_;
107
108  if(TYPEOF(socket_type_) != STRSXP) {
109    REprintf("socket type must be a string.\n");
110    return R_NilValue;
111  }
112
113  int socket_type = string_to_socket_type(CHAR(STRING_ELT(socket_type_,0)));
114  if(socket_type < 0) {
115    REprintf("socket type not found.\n");
116    return R_NilValue;
117  }
118
119  zmq::context_t* context(NULL);
120  try {
121    context = reinterpret_cast<zmq::context_t*>(checkExternalPointer(context_,"zmq::context_t*"));
122  } catch(std::logic_error &e) {
123      REprintf("%s\n",e.what());
124      return R_NilValue;
125  }
126
127  zmq::socket_t* socket = new zmq::socket_t(*context,socket_type);
128  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
129  // for debugging
130  //uint64_t hwm = 1;
131  //socket->setsockopt(ZMQ_HWM, &hwm, sizeof (hwm));
132
133  PROTECT(socket_ = R_MakeExternalPtr(reinterpret_cast<void*>(socket),install("zmq::socket_t*"),R_NilValue));
134  R_RegisterCFinalizerEx(socket_, socketFinalizer, TRUE);
135  UNPROTECT(1);
136  return socket_;
137}
138
139SEXP bindSocket(SEXP socket_, SEXP address_) {
140  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
141
142  if(TYPEOF(address_) != STRSXP) {
143    REprintf("address type must be a string.\n");
144    UNPROTECT(1);
145    return R_NilValue;
146  }
147
148  try {
149    zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
150    socket->bind(CHAR(STRING_ELT(address_,0)));
151  } catch(std::exception& e) {
152    REprintf("%s\n",e.what());
153    LOGICAL(ans)[0] = 0;
154  }
155
156  UNPROTECT(1);
157  return ans;
158}
159
160static short rzmq_build_event_bitmask(SEXP askevents) {
161    short bitmask = 0;
162    if(TYPEOF(askevents) == STRSXP) {
163        for (int i = 0; i < LENGTH(askevents); i++) {
164            const char *ask = translateChar(STRING_ELT(askevents, i));
165            if (strcmp(ask, "read") == 0) {
166                bitmask |= ZMQ_POLLIN;
167            } else if (strcmp(ask, "write") == 0) {
168                bitmask |= ZMQ_POLLOUT;
169            } else if (strcmp(ask, "error") == 0) {
170                bitmask |= ZMQ_POLLERR;
171            } else {
172                error("unrecognized requests poll event %s.", ask);
173            }
174        }
175    } else {
176        error("event list passed to poll must be a string or vector of strings");
177    }
178    return bitmask;
179}
180
181SEXP pollSocket(SEXP sockets_, SEXP events_, SEXP timeout_) {
182    SEXP result;
183    
184    if(TYPEOF(timeout_) != INTSXP) {
185        error("poll timeout must be an integer.");
186    }
187
188    if(TYPEOF(sockets_) != VECSXP || LENGTH(sockets_) == 0) {
189        error("A non-empy list of sockets is required as first argument.");
190    }
191
192    int nsock = LENGTH(sockets_);
193    PROTECT(result = allocVector(VECSXP, nsock));
194
195    if (TYPEOF(events_) != VECSXP) {
196        error("event list must be a list of strings or a list of vectors of strings.");
197    }
198    if(LENGTH(events_) != nsock) {
199        error("event list must be the same length as socket list.");
200    }
201
202    zmq_pollitem_t *pitems = (zmq_pollitem_t*)R_alloc(nsock, sizeof(zmq_pollitem_t));
203    if (pitems == NULL) {
204        error("failed to allocate memory for zmq_pollitem_t array.");
205    }
206
207    try {
208        for (int i = 0; i < nsock; i++) {
209            zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(VECTOR_ELT(sockets_, i), "zmq::socket_t*"));
210            pitems[i].socket = (void*)*socket;
211            pitems[i].events = rzmq_build_event_bitmask(VECTOR_ELT(events_, i));
212        }
213
214        int rc = zmq::poll(pitems, nsock, *INTEGER(timeout_));
215
216        if(rc >= 0) {
217            for (int i = 0; i < nsock; i++) {
218                SEXP events, names;
219
220                // Pre count number of polled events so we can
221                // allocate appropriately sized lists.
222                short eventcount = 0;
223                if (pitems[i].events & ZMQ_POLLIN) eventcount++;
224                if (pitems[i].events & ZMQ_POLLOUT) eventcount++;
225                if (pitems[i].events & ZMQ_POLLERR) eventcount++;
226
227                PROTECT(events = allocVector(VECSXP, eventcount));
228                PROTECT(names = allocVector(VECSXP, eventcount));
229
230                eventcount = 0;
231                if (pitems[i].events & ZMQ_POLLIN) {
232                    SET_VECTOR_ELT(events, eventcount, ScalarLogical(pitems[i].revents & ZMQ_POLLIN));
233                    SET_VECTOR_ELT(names, eventcount, mkChar("read"));
234                    eventcount++;
235                }
236
237                if (pitems[i].events & ZMQ_POLLOUT) {
238                    SET_VECTOR_ELT(names, eventcount, mkChar("write"));
239
240                    SET_VECTOR_ELT(events, eventcount, ScalarLogical(pitems[i].revents & ZMQ_POLLOUT));
241                    eventcount++;
242                }
243
244                if (pitems[i].events & ZMQ_POLLERR) {
245                    SET_VECTOR_ELT(names, eventcount, mkChar("error"));
246                    SET_VECTOR_ELT(events, eventcount, ScalarLogical(pitems[i].revents & ZMQ_POLLERR));
247                }
248                setAttrib(events, R_NamesSymbol, names);
249                SET_VECTOR_ELT(result, i, events);
250            }
251        } else {
252            error("polling zmq sockets failed.");
253        }
254    } catch(std::exception& e) {
255        error(e.what());
256    }
257    // Release the result list (1), and per socket
258    // events lists with associated names (2*nsock).
259    UNPROTECT(1 + 2*nsock);
260    return result;
261}
262
263SEXP connectSocket(SEXP socket_, SEXP address_) {
264  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
265
266  if(TYPEOF(address_) != STRSXP) {
267    REprintf("address type must be a string.\n");
268    UNPROTECT(1);
269    return R_NilValue;
270  }
271  try {
272    zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
273    socket->connect(CHAR(STRING_ELT(address_,0)));    
274  } catch(std::exception& e) {
275    REprintf("%s\n",e.what());
276    LOGICAL(ans)[0] = 0;
277  }
278
279  UNPROTECT(1);
280  return ans;
281}
282
283SEXP sendSocket(SEXP socket_, SEXP data_, SEXP send_more_) {
284  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1));
285  bool status(false);
286  if(TYPEOF(data_) != RAWSXP) {
287    REprintf("data type must be raw (RAWSXP).\n");
288    UNPROTECT(1);
289    return R_NilValue;
290  }
291
292  if(TYPEOF(send_more_) != LGLSXP) {
293    REprintf("send.more type must be logical (LGLSXP).\n");
294    UNPROTECT(1);
295    return R_NilValue;
296  }
297
298  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
299  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
300
301  zmq::message_t msg (length(data_));
302  memcpy(msg.data(), RAW(data_), length(data_));
303
304  bool send_more = LOGICAL(send_more_)[0];
305  try {
306    if(send_more) {
307      status = socket->send(msg,ZMQ_SNDMORE);
308    } else {
309      status = socket->send(msg);
310    }
311  } catch(std::exception& e) {
312    REprintf("%s\n",e.what());
313  }
314  LOGICAL(ans)[0] = static_cast<int>(status);
315  UNPROTECT(1);
316  return ans;
317}
318
319SEXP sendNullMsg(SEXP socket_, SEXP send_more_) {
320  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1));
321  bool status(false);
322
323  if(TYPEOF(send_more_) != LGLSXP) {
324    REprintf("send.more type must be logical (LGLSXP).\n");
325    UNPROTECT(1);
326    return R_NilValue;
327  }
328
329  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
330  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
331  zmq::message_t msg(0);
332
333  bool send_more = LOGICAL(send_more_)[0];
334  try {
335    if(send_more) {
336      status = socket->send(msg,ZMQ_SNDMORE);
337    } else {
338      status = socket->send(msg);
339    }
340  } catch(std::exception& e) {
341    REprintf("%s\n",e.what());
342  }
343  LOGICAL(ans)[0] = static_cast<int>(status);
344  UNPROTECT(1);
345  return ans;
346}
347
348SEXP receiveNullMsg(SEXP socket_) {
349  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1));
350  bool status(false);
351
352  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
353  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
354  zmq::message_t msg;
355  try {
356    status = socket->recv(&msg);
357  } catch(std::exception& e) {
358    REprintf("%s\n",e.what());
359  }
360  LOGICAL(ans)[0] = static_cast<int>(status) && (msg.size() == 0);
361  UNPROTECT(1);
362  return ans;
363}
364
365SEXP receiveSocket(SEXP socket_) {
366  SEXP ans;
367  bool status(false);
368  zmq::message_t msg;
369  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
370  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
371  try {
372    status = socket->recv(&msg);
373  } catch(std::exception& e) {
374    REprintf("%s\n",e.what());
375  }
376  if(status) {
377    PROTECT(ans = allocVector(RAWSXP,msg.size()));
378    memcpy(RAW(ans),msg.data(),msg.size());
379    UNPROTECT(1);
380    return ans;
381  }
382
383  return R_NilValue;
384}
385
386SEXP receiveString(SEXP socket_) {
387  SEXP ans;
388  bool status(false);
389  zmq::message_t msg;
390  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
391  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
392  try {
393    status = socket->recv(&msg);
394  } catch(std::exception& e) {
395    REprintf("%s\n",e.what());
396  }
397  if(status) {
398    PROTECT(ans = allocVector(STRSXP,1));
399    char* string_msg = new char[msg.size() + 1];
400    if(string_msg == NULL) {
401      UNPROTECT(1);
402      return R_NilValue;
403    }
404    memcpy(string_msg,msg.data(),msg.size());
405    string_msg[msg.size()] = 0;
406    SET_STRING_ELT(ans, 0, mkChar(string_msg));
407    UNPROTECT(1);
408    return ans;
409  }
410  return R_NilValue;
411}
412
413SEXP receiveInt(SEXP socket_) {
414  SEXP ans;
415  bool status(false);
416  zmq::message_t msg;
417  try {
418    zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
419    status = socket->recv(&msg);
420  } catch(std::exception& e) {
421    REprintf("%s\n",e.what());
422  }
423  if(status) {
424    if(msg.size() != sizeof(int)) {
425      REprintf("bad integer size on remote machine.\n");
426      return R_NilValue;
427    }
428    PROTECT(ans = allocVector(INTSXP,1));
429    memcpy(INTEGER(ans),msg.data(),msg.size());
430    UNPROTECT(1);
431    return ans;
432  }
433  return R_NilValue;
434}
435
436SEXP receiveDouble(SEXP socket_) {
437  SEXP ans;
438  bool status(false);
439  zmq::message_t msg;
440  try {
441    zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
442    status = socket->recv(&msg);
443  } catch(std::exception& e) {
444    REprintf("%s\n",e.what());
445  }
446  if(status) {
447    if(msg.size() != sizeof(double)) {
448      REprintf("bad double size on remote machine.\n");
449      return R_NilValue;
450    }
451    PROTECT(ans = allocVector(REALSXP,1));
452    memcpy(REAL(ans),msg.data(),msg.size());
453    UNPROTECT(1);
454    return ans;
455  }
456  return R_NilValue;
457}
458
459SEXP set_hwm(SEXP socket_, SEXP option_value_) {
460
461  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
462  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
463  if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
464  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
465
466  uint64_t option_value(INTEGER(option_value_)[0]);
467  try {
468    socket->setsockopt(ZMQ_HWM, &option_value, sizeof(uint64_t));
469  } catch(std::exception& e) {
470    REprintf("%s\n",e.what());
471    LOGICAL(ans)[0] = 0;
472  }
473  UNPROTECT(1);
474  return ans;
475}
476
477SEXP set_swap(SEXP socket_, SEXP option_value_) {
478
479  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
480  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
481  if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
482  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
483
484  int64_t option_value(INTEGER(option_value_)[0]);
485  try {
486    socket->setsockopt(ZMQ_SWAP, &option_value, sizeof(int64_t));
487  } catch(std::exception& e) {
488    REprintf("%s\n",e.what());
489    LOGICAL(ans)[0] = 0;
490  }
491  UNPROTECT(1);
492  return ans;
493}
494
495
496SEXP set_affinity(SEXP socket_, SEXP option_value_) {
497
498  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
499  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
500  if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
501  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
502
503  uint64_t option_value(INTEGER(option_value_)[0]);
504  try {
505    socket->setsockopt(ZMQ_AFFINITY, &option_value, sizeof(uint64_t));
506  } catch(std::exception& e) {
507    REprintf("%s\n",e.what());
508    LOGICAL(ans)[0] = 0;
509  }
510  UNPROTECT(1);
511  return ans;
512}
513
514SEXP set_identity(SEXP socket_, SEXP option_value_) {
515
516  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
517  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
518  if(TYPEOF(option_value_)!=STRSXP) { REprintf("option value must be a string.\n");return R_NilValue; }
519  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
520  const char* option_value = CHAR(STRING_ELT(option_value_,0));
521  try {
522    socket->setsockopt(ZMQ_IDENTITY, option_value,strlen(option_value));
523  } catch(std::exception& e) {
524    REprintf("%s\n",e.what());
525    LOGICAL(ans)[0] = 0;
526  }
527  UNPROTECT(1);
528  return ans;
529}
530
531SEXP subscribe(SEXP socket_, SEXP option_value_) {
532
533  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
534  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
535  if(TYPEOF(option_value_)!=STRSXP) { REprintf("option value must be a string.\n");return R_NilValue; }
536  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
537  const char* option_value = CHAR(STRING_ELT(option_value_,0));
538  try {
539    socket->setsockopt(ZMQ_SUBSCRIBE, option_value,strlen(option_value));
540  } catch(std::exception& e) {
541    REprintf("%s\n",e.what());
542    LOGICAL(ans)[0] = 0;
543  }
544  UNPROTECT(1);
545  return ans;
546}
547
548SEXP unsubscribe(SEXP socket_, SEXP option_value_) {
549
550  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
551  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
552  if(TYPEOF(option_value_)!=STRSXP) { REprintf("option value must be a string.\n");return R_NilValue; }
553  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
554  const char* option_value = CHAR(STRING_ELT(option_value_,0));
555  try {
556    socket->setsockopt(ZMQ_UNSUBSCRIBE, option_value,strlen(option_value));
557  } catch(std::exception& e) {
558    REprintf("%s\n",e.what());
559    LOGICAL(ans)[0] = 0;
560  }
561  UNPROTECT(1);
562  return ans;
563}
564
565SEXP set_rate(SEXP socket_, SEXP option_value_) {
566
567  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
568  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
569  if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
570  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
571
572  int64_t option_value(INTEGER(option_value_)[0]);
573  try {
574    socket->setsockopt(ZMQ_RATE, &option_value, sizeof(int64_t));
575  } catch(std::exception& e) {
576    REprintf("%s\n",e.what());
577    LOGICAL(ans)[0] = 0;
578  }
579  UNPROTECT(1);
580  return ans;
581}
582
583SEXP set_recovery_ivl(SEXP socket_, SEXP option_value_) {
584
585  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
586  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
587  if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
588  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
589
590  int64_t option_value(INTEGER(option_value_)[0]);
591  try {
592    socket->setsockopt(ZMQ_RECOVERY_IVL, &option_value, sizeof(int64_t));
593  } catch(std::exception& e) {
594    REprintf("%s\n",e.what());
595    LOGICAL(ans)[0] = 0;
596  }
597  UNPROTECT(1);
598  return ans;
599}
600
601SEXP set_recovery_ivl_msec(SEXP socket_, SEXP option_value_) {
602
603  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
604  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
605  if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
606  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
607
608  int64_t option_value(INTEGER(option_value_)[0]);
609  try {
610    socket->setsockopt(ZMQ_RECOVERY_IVL_MSEC, &option_value, sizeof(int64_t));
611  } catch(std::exception& e) {
612    REprintf("%s\n",e.what());
613    LOGICAL(ans)[0] = 0;
614  }
615  UNPROTECT(1);
616  return ans;
617}
618
619SEXP set_mcast_loop(SEXP socket_, SEXP option_value_) {
620
621  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
622  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
623  if(TYPEOF(option_value_)!=LGLSXP) { REprintf("option value must be a logical.\n");return R_NilValue; }
624  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
625
626  int64_t option_value(LOGICAL(option_value_)[0]);
627  try {
628    socket->setsockopt(ZMQ_MCAST_LOOP, &option_value, sizeof(int64_t));
629  } catch(std::exception& e) {
630    REprintf("%s\n",e.what());
631    LOGICAL(ans)[0] = 0;
632  }
633  UNPROTECT(1);
634  return ans;
635}
636
637SEXP set_sndbuf(SEXP socket_, SEXP option_value_) {
638
639  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
640  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
641  if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
642  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
643
644  uint64_t option_value(INTEGER(option_value_)[0]);
645  try {
646    socket->setsockopt(ZMQ_SNDBUF, &option_value, sizeof(uint64_t));
647  } catch(std::exception& e) {
648    REprintf("%s\n",e.what());
649    LOGICAL(ans)[0] = 0;
650  }
651  UNPROTECT(1);
652  return ans;
653}
654
655SEXP set_rcvbuf(SEXP socket_, SEXP option_value_) {
656
657  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
658  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
659  if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
660  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
661
662  uint64_t option_value(INTEGER(option_value_)[0]);
663  try {
664    socket->setsockopt(ZMQ_RCVBUF, &option_value, sizeof(uint64_t));
665  } catch(std::exception& e) {
666    REprintf("%s\n",e.what());
667    LOGICAL(ans)[0] = 0;
668  }
669  UNPROTECT(1);
670  return ans;
671}
672
673SEXP set_linger(SEXP socket_, SEXP option_value_) {
674
675  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
676  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
677  if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
678  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
679
680  int option_value(INTEGER(option_value_)[0]);
681  try {
682    socket->setsockopt(ZMQ_LINGER, &option_value, sizeof(int));
683  } catch(std::exception& e) {
684    REprintf("%s\n",e.what());
685    LOGICAL(ans)[0] = 0;
686  }
687  UNPROTECT(1);
688  return ans;
689}
690
691SEXP set_reconnect_ivl(SEXP socket_, SEXP option_value_) {
692
693  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
694  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
695  if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
696  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
697
698  int option_value(INTEGER(option_value_)[0]);
699  try {
700    socket->setsockopt(ZMQ_RECONNECT_IVL, &option_value, sizeof(int));
701  } catch(std::exception& e) {
702    REprintf("%s\n",e.what());
703    LOGICAL(ans)[0] = 0;
704  }
705  UNPROTECT(1);
706  return ans;
707}
708
709SEXP set_zmq_backlog(SEXP socket_, SEXP option_value_) {
710
711  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
712  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
713  if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
714  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
715
716  int option_value(INTEGER(option_value_)[0]);
717  try {
718    socket->setsockopt(ZMQ_BACKLOG, &option_value, sizeof(int));
719  } catch(std::exception& e) {
720    REprintf("%s\n",e.what());
721    LOGICAL(ans)[0] = 0;
722  }
723  UNPROTECT(1);
724  return ans;
725}
726
727SEXP set_reconnect_ivl_max(SEXP socket_, SEXP option_value_) {
728
729  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
730  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
731  if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
732  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
733
734  int option_value(INTEGER(option_value_)[0]);
735  try {
736    socket->setsockopt(ZMQ_RECONNECT_IVL_MAX, &option_value, sizeof(int));
737  } catch(std::exception& e) {
738    REprintf("%s\n",e.what());
739    LOGICAL(ans)[0] = 0;
740  }
741  UNPROTECT(1);
742  return ans;
743}
744
745
746SEXP get_rcvmore(SEXP socket_) {
747
748  zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
749  if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
750
751  int64_t option_value;
752  size_t option_value_len = sizeof(option_value);
753  try {
754    socket->getsockopt(ZMQ_RCVMORE, &option_value, &option_value_len);
755  } catch(std::exception& e) {
756    REprintf("%s\n",e.what());
757    return R_NilValue;
758  }
759  SEXP ans; PROTECT(ans = allocVector(LGLSXP,1));
760  LOGICAL(ans)[0] = static_cast<int>(option_value);
761  UNPROTECT(1);
762  return ans;
763}
764
765// #define ZMQ_RCVMORE 13
766// #define ZMQ_FD 14
767// #define ZMQ_EVENTS 15
768// #define ZMQ_TYPE 16
769
770SEXP rzmq_serialize(SEXP data, SEXP rho) {
771  static SEXP R_serialize_fun  = findVar(install("serialize"), R_GlobalEnv);
772  SEXP R_fcall, ans;
773
774  if(!isEnvironment(rho)) error("'rho' should be an environment");
775  PROTECT(R_fcall = lang3(R_serialize_fun, data, R_NilValue));
776  PROTECT(ans = eval(R_fcall, rho));
777  UNPROTECT(2);
778  return ans;
779}
780
781SEXP rzmq_unserialize(SEXP data, SEXP rho) {
782  static SEXP R_unserialize_fun  = findVar(install("unserialize"), R_GlobalEnv);
783  SEXP R_fcall, ans;
784
785  if(!isEnvironment(rho)) error("'rho' should be an environment");
786  PROTECT(R_fcall = lang2(R_unserialize_fun, data));
787  PROTECT(ans = eval(R_fcall, rho));
788  UNPROTECT(2);
789  return ans;
790}