/** * Make a data packet * @param unknown_type $type * @param unknown_type $string NULL terminated string */ function _rserve_make_data($type, $string) { if ($type == Rserve_Connection::DT_STRING) { $string .= chr(0); } $len = strlen($string); // Length of the binary string $pad = $len % 4; // Number of padding needed if ($pad > 0) { $pad = 4 - $pad; } $len += $pad; $s = chr($type & 255); // [0] Type $s .= mkint24($len); // [1] Length (24bits) $s .= $string; // Data if ($pad) { $s .= str_repeat(chr(0), $pad); } return $s; }
/** * * @param Rserve_REXP $value * This function is not functionnal. Please use it only for testing */ public static function createBinary(Rserve_REXP $value) { // Current offset $o = 0; // Init with header size $contents = ''; $type = $value->getType(); switch ($type) { case self::XT_S4: case self::XT_NULL: break; case self::XT_INT: $v = (int) $value->at(0); $contents .= mkint32($v); $o += 4; break; case self::XT_DOUBLE: $v = (double) $value->at(0); $contents .= mkfloat64($v); $o += 8; break; case self::XT_ARRAY_INT: $vv = $value->getValues(); $n = count($vv); for ($i = 0; $i < $n; ++$i) { $v = $vv[$i]; $contents .= mkint32($v); $o += 4; } break; case self::XT_ARRAY_BOOL: $vv = $value->getValues(); $n = count($vv); $contents .= mkint32($n); $o += 4; if ($n) { for ($i = 0; $i < $n; ++$i) { $v = $vv[$i]; if (is_null($v)) { $v = 2; } else { $v = (int) $v; } if ($v != 0 and $v != 1) { $v = 2; } $contents .= chr($v); ++$o; } while (($o & 3) != 0) { $contents .= chr(3); ++$o; } } break; case self::XT_ARRAY_DOUBLE: $vv = $value->getValues(); $n = count($vv); for ($i = 0; $i < $n; ++$i) { $v = (double) $vv[$i]; $contents .= mkfloat64($v); $o += 8; } break; case self::XT_RAW: $v = $value->getValue(); $n = $value->length(); $contents .= mkint32($n); $o += 4; $contents .= $v; break; case self::XT_ARRAY_STR: $vv = $value->getValues(); $n = count($vv); for ($i = 0; $i < $n; ++$i) { $v = $vv[$i]; if (!is_null($v)) { $contents .= $v; $contents .= chr(0); $o += strlen($v) + 1; } else { $contents .= chr(255) . chr(0); $o += 2; } } while (($o & 3) != 0) { $contents .= chr(1); ++$o; } break; case self::XT_LIST_TAG: case self::XT_LIST_NOTAG: case self::XT_LANG_TAG: case self::XT_LANG_NOTAG: case self::XT_LIST: case self::XT_VECTOR: case self::XT_VECTOR_EXP: $l = $value->getValues(); if ($type == XT_LIST_TAG || $type == XT_LANG_TAG) { $names = $value->getNames(); } $i = 0; $n = count($l); while ($i < $n) { $x = $l[$i]; if (is_null($x)) { $x = new Rserve_REXP_Null(); } $iof = strlen($contents); $contents .= self::createBinary($x); if ($type == XT_LIST_TAG || $type == XT_LANG_TAG) { $sym = new Rserve_REXP_Symbol(); $sym->setValue($names[$i]); $contents .= self::createBinary($sym); } ++$i; } break; case self::XT_SYMNAME: case self::XT_STR: $s = (string) $value->getValues(); $contents .= $s; $o += strlen($s); $contents .= chr(0); ++$o; //padding if necessary while (($o & 3) != 0) { $contents .= chr(0); ++$o; } break; } /* TODO: handling attr $attr = $value->attributes(); $attr_bin = ''; if( is_null($attr) ) { $attr_off = self::createBinary($attr, $attr_bin, 0); $attr_flag = self::XT_HAS_ATTR; } else { $attr_off = 0; $attr_flag = 0; } // [0] (4) header SEXP: len=4+m+n, XT_HAS_ATTR is set // [4] (4) header attribute SEXP: len=n // [8] (n) data attribute SEXP // [8+n] (m) data SEXP */ $attr_flag = 0; $length = $o; $isLarge = $length > 0xfffff0; $code = $type | $attr_flag; // SEXP Header (without ATTR) // [0] (byte) eXpression Type // [1] (24-bit int) length $r = chr($code & 255); $r .= mkint24($length); $r .= $contents; return $r; }
function mkp_str($cmd, $string) { $n = strlen($string) + 1; $string .= chr(0); while (($n & 3) != 0) { $string .= chr(1); $n++; } return mkint32($cmd) . mkint32($n + 4) . mkint32(0) . mkint32(0) . chr(4) . mkint24($n) . $string; }
/** * Create a packet for QAP1 message * @param int $cmd command identifier * @param string $string contents of the message */ function _rserve_make_packet($cmd, $string) { $n = strlen($string) + 1; $string .= chr(0); while (($n & 3) != 0) { $string .= chr(1); $n++; } // [0] (int) command // [4] (int) length of the message (bits 0-31) // [8] (int) offset of the data part // [12] (int) length of the message (bits 32-63) return mkint32($cmd) . mkint32($n + 4) . mkint32(0) . mkint32(0) . chr(4) . mkint24($n) . $string; }
function Rserve_assign_raw($socket, $name, $what) { // CMD_setSEXP $bl = strlen($what); if ($bl > 16777088) { trigger_error("Body in Rserve_assign_raw is too big ({$bl} bytes), only small QAP packets are currently supported."); } $n = strlen($name) + 1; $name .= chr(0); while (($n & 3) != 0) { $name .= chr(1); $n++; } // [CMD_setSEXP][DT_STRING(name)][DT_SEXP([XT_RAW, (i32) len, what])] = payload + 4 + 4 + 8 $pkt = mkint32(0x20) . mkint32($n + $bl + 16) . mkint32(0) . mkint32(0) . chr(4) . mkint24($n) . $name . chr(10) . mkint24($bl + 8) . chr(37) . mkint24($bl + 4) . mkint32($bl) . $what; socket_send($socket, $pkt, strlen($pkt), 0); $r = get_rsp($socket); $res = int32($r); $sc = $res >> 24 & 127; $rr = $res & 255; if ($rr != 1) { echo "eval failed with error code " . $sc; return FALSE; } return TRUE; }