Beispiel #1
0
*/  REBSER *Compress(REBSER *input, REBINT index, REBINT len, REBFLG use_crc)
/*
**      Compress a binary (only).
**		data
**		/part
**		length
**		/crc32
**
**      Note: If the file length is "small", it can't overrun on
**      compression too much so we use our magic numbers; otherwise,
**      we'll just be safe by a percentage of the file size.  This may
**      be a bit much, though.
**
***********************************************************************/
{
    // NOTE: The use_crc flag is not present in Zlib 1.2.8
    // Instead, compress's fifth paramter is the compression level
    // It can be a value from 1 to 9, or Z_DEFAULT_COMPRESSION if you
    // want it to pick what the library author considers the "worth it"
    // tradeoff of time to generally suggest.

    uLongf size;
    REBSER *output;
    REBINT err;
    REBYTE out_size[sizeof(REBCNT)];

    if (len < 0) Trap_DEAD_END(RE_PAST_END); // !!! better msg needed
    size = len + (len > STERLINGS_MAGIC_NUMBER ? len / 10 + 12 : STERLINGS_MAGIC_FIX);
    output = Make_Binary(size);

    //DISABLE_GC;	// !!! why??
    // dest, dest-len, src, src-len, level
    err = z_compress2(BIN_HEAD(output), &size, BIN_HEAD(input) + index, len, Z_DEFAULT_COMPRESSION);
    if (err) {
        REBVAL arg;
        if (err == Z_MEM_ERROR) Trap_DEAD_END(RE_NO_MEMORY);
        SET_INTEGER(&arg, err);
        Trap1_DEAD_END(RE_BAD_PRESS, &arg); //!!!provide error string descriptions
    }
    SET_STR_END(output, size);
    SERIES_TAIL(output) = size;
    REBCNT_To_Bytes(out_size, (REBCNT)len); // Tag the size to the end.
    Append_Series(output, (REBYTE*)out_size, sizeof(REBCNT));
    if (SERIES_AVAIL(output) > 1024) // Is there wasted space?
        output = Copy_Series(output); // Trim it down if too big. !!! Revisit this based on mem alloc alg.
    //ENABLE_GC;

    return output;
}
Beispiel #2
0
*/  REBSER *Compress(REBSER *input, REBINT index, REBINT len, REBFLG use_crc)
/*
**      Compress a binary (only).
**		data
**		/part
**		length
**		/crc32
**
**      Note: If the file length is "small", it can't overrun on
**      compression too much so we use our magic numbers; otherwise,
**      we'll just be safe by a percentage of the file size.  This may
**      be a bit much, though.
**
***********************************************************************/
{
	REBCNT size;
	REBSER *output;
	REBINT err;
	REBYTE out_size[4];

	if (len < 0) Trap0(RE_PAST_END); // !!! better msg needed
	size = len + (len > STERLINGS_MAGIC_NUMBER ? len / 10 + 12 : STERLINGS_MAGIC_FIX);
	output = Make_Binary(size);

	//DISABLE_GC;	// !!! why??
	// dest, dest-len, src, src-len, level
	err = Z_compress2(BIN_HEAD(output), (uLongf*)&size, BIN_HEAD(input) + index, len, use_crc);
	if (err) {
		if (err == Z_MEM_ERROR) Trap0(RE_NO_MEMORY);
		SET_INTEGER(DS_RETURN, err);
		Trap1(RE_BAD_PRESS, DS_RETURN); //!!!provide error string descriptions
	}
	SET_STR_END(output, size);
	SERIES_TAIL(output) = size;
	Long_To_Bytes(out_size, (REBCNT)len); // Tag the size to the end.
	Append_Series(output, (REBYTE*)out_size, 4);
	if (SERIES_AVAIL(output) > 1024) // Is there wasted space?
		output = Copy_Series(output); // Trim it down if too big. !!! Revisit this based on mem alloc alg.
	//ENABLE_GC;

	return output;
}
Beispiel #3
0
RL_API int RL_Series(REBSER *series, REBCNT what)
/*
**	Get series information.
**
**	Returns:
**		Returns information related to a series.
**	Arguments:
**		series - any series pointer (string or block)
**		what - indicates what information to return (see RXI_SER enum)
**	Notes:
**		Invalid what arg nums will return zero.
*/
{
	switch (what) {
	case RXI_SER_DATA: return (int)SERIES_DATA(series); // problem for 64 bit !!
	case RXI_SER_TAIL: return SERIES_TAIL(series);
	case RXI_SER_LEFT: return SERIES_AVAIL(series);
	case RXI_SER_SIZE: return SERIES_REST(series);
	case RXI_SER_WIDE: return SERIES_WIDE(series);
	}
	return 0;
}
Beispiel #4
0
//
//  Transport_Actor: C
//
static REB_R Transport_Actor(struct Reb_Call *call_, REBSER *port, REBCNT action, enum Transport_Types proto)
{
    REBREQ *sock;   // IO request
    REBVAL *spec;   // port spec
    REBVAL *arg;    // action argument value
    REBVAL *val;    // e.g. port number value
    REBINT result;  // IO result
    REBCNT refs;    // refinement argument flags
    REBCNT len;     // generic length
    REBSER *ser;    // simplifier

    Validate_Port(port, action);

    *D_OUT = *D_ARG(1);
    arg = DS_ARGC > 1 ? D_ARG(2) : NULL;

    sock = cast(REBREQ*, Use_Port_State(port, RDI_NET, sizeof(*sock)));
    if (proto == TRANSPORT_UDP) {
        SET_FLAG(sock->modes, RST_UDP);
    }
    //Debug_Fmt("Sock: %x", sock);
    spec = OFV(port, STD_PORT_SPEC);
    if (!IS_OBJECT(spec)) fail (Error(RE_INVALID_PORT));

    // sock->timeout = 4000; // where does this go? !!!

    // HOW TO PREVENT OVERWRITE DURING BUSY OPERATION!!!
    // Should it just ignore it or cause an error?

    // Actions for an unopened socket:
    if (!IS_OPEN(sock)) {

        switch (action) {   // Ordered by frequency

        case A_OPEN:

            arg = Obj_Value(spec, STD_PORT_SPEC_NET_HOST);
            val = Obj_Value(spec, STD_PORT_SPEC_NET_PORT_ID);

            if (OS_DO_DEVICE(sock, RDC_OPEN))
                fail (Error_On_Port(RE_CANNOT_OPEN, port, -12));
            SET_OPEN(sock);

            // Lookup host name (an extra TCP device step):
            if (IS_STRING(arg)) {
                sock->common.data = VAL_BIN(arg);
                sock->special.net.remote_port = IS_INTEGER(val) ? VAL_INT32(val) : 80;
                result = OS_DO_DEVICE(sock, RDC_LOOKUP);  // sets remote_ip field
                if (result < 0)
                    fail (Error_On_Port(RE_NO_CONNECT, port, sock->error));
                return R_OUT;
            }

            // Host IP specified:
            else if (IS_TUPLE(arg)) {
                sock->special.net.remote_port = IS_INTEGER(val) ? VAL_INT32(val) : 80;
                memcpy(&sock->special.net.remote_ip, VAL_TUPLE(arg), 4);
                break;
            }

            // No host, must be a LISTEN socket:
            else if (IS_NONE(arg)) {
                SET_FLAG(sock->modes, RST_LISTEN);
                sock->common.data = 0; // where ACCEPT requests are queued
                sock->special.net.local_port = IS_INTEGER(val) ? VAL_INT32(val) : 8000;
                break;
            }
            else
                fail (Error_On_Port(RE_INVALID_SPEC, port, -10));

        case A_CLOSE:
            return R_OUT;

        case A_OPENQ:
            return R_FALSE;

        case A_UPDATE:  // allowed after a close
            break;

        default:
            fail (Error_On_Port(RE_NOT_OPEN, port, -12));
        }
    }

    // Actions for an open socket:
    switch (action) {   // Ordered by frequency

    case A_UPDATE:
        // Update the port object after a READ or WRITE operation.
        // This is normally called by the WAKE-UP function.
        arg = OFV(port, STD_PORT_DATA);
        if (sock->command == RDC_READ) {
            if (ANY_BINSTR(arg)) VAL_TAIL(arg) += sock->actual;
        }
        else if (sock->command == RDC_WRITE) {
            SET_NONE(arg);  // Write is done.
        }
        return R_NONE;

    case A_READ:
        // Read data into a buffer, expanding the buffer if needed.
        // If no length is given, program must stop it at some point.
        refs = Find_Refines(call_, ALL_READ_REFS);
        if (
            !GET_FLAG(sock->modes, RST_UDP)
            && !GET_FLAG(sock->state, RSM_CONNECT)
        ) {
            fail (Error_On_Port(RE_NOT_CONNECTED, port, -15));
        }

        // Setup the read buffer (allocate a buffer if needed):
        arg = OFV(port, STD_PORT_DATA);
        if (!IS_STRING(arg) && !IS_BINARY(arg)) {
            Val_Init_Binary(arg, Make_Binary(NET_BUF_SIZE));
        }
        ser = VAL_SERIES(arg);
        sock->length = SERIES_AVAIL(ser); // space available
        if (sock->length < NET_BUF_SIZE/2) Extend_Series(ser, NET_BUF_SIZE);
        sock->length = SERIES_AVAIL(ser);
        sock->common.data = STR_TAIL(ser); // write at tail
        //if (SERIES_TAIL(ser) == 0)
        sock->actual = 0;  // Actual for THIS read, not for total.

        //Print("(max read length %d)", sock->length);
        result = OS_DO_DEVICE(sock, RDC_READ); // recv can happen immediately
        if (result < 0) fail (Error_On_Port(RE_READ_ERROR, port, sock->error));
        break;

    case A_WRITE:
        // Write the entire argument string to the network.
        // The lower level write code continues until done.

        refs = Find_Refines(call_, ALL_WRITE_REFS);
        if (!GET_FLAG(sock->modes, RST_UDP)
            && !GET_FLAG(sock->state, RSM_CONNECT))
            fail (Error_On_Port(RE_NOT_CONNECTED, port, -15));

        // Determine length. Clip /PART to size of string if needed.
        spec = D_ARG(2);
        len = VAL_LEN(spec);
        if (refs & AM_WRITE_PART) {
            REBCNT n = Int32s(D_ARG(ARG_WRITE_LIMIT), 0);
            if (n <= len) len = n;
        }

        // Setup the write:
        *OFV(port, STD_PORT_DATA) = *spec;  // keep it GC safe
        sock->length = len;
        sock->common.data = VAL_BIN_DATA(spec);
        sock->actual = 0;

        //Print("(write length %d)", len);
        result = OS_DO_DEVICE(sock, RDC_WRITE); // send can happen immediately
        if (result < 0) fail (Error_On_Port(RE_WRITE_ERROR, port, sock->error));
        if (result == DR_DONE) SET_NONE(OFV(port, STD_PORT_DATA));
        break;

    case A_PICK:
        // FIRST server-port returns new port connection.
        len = Get_Num_Arg(arg); // Position
        if (len == 1 && GET_FLAG(sock->modes, RST_LISTEN) && sock->common.data)
            Accept_New_Port(D_OUT, port, sock); // sets D_OUT
        else
            fail (Error_Out_Of_Range(arg));
        break;

    case A_QUERY:
        // Get specific information - the scheme's info object.
        // Special notation allows just getting part of the info.
        Ret_Query_Net(port, sock, D_OUT);
        break;

    case A_OPENQ:
        // Connect for clients, bind for servers:
        if (sock->state & ((1<<RSM_CONNECT) | (1<<RSM_BIND))) return R_TRUE;
        return R_FALSE;

    case A_CLOSE:
        if (IS_OPEN(sock)) {
            OS_DO_DEVICE(sock, RDC_CLOSE);
            SET_CLOSED(sock);
        }
        break;

    case A_LENGTH:
        arg = OFV(port, STD_PORT_DATA);
        len = ANY_SERIES(arg) ? VAL_TAIL(arg) : 0;
        SET_INTEGER(D_OUT, len);
        break;

    case A_OPEN:
        result = OS_DO_DEVICE(sock, RDC_CONNECT);
        if (result < 0)
            fail (Error_On_Port(RE_NO_CONNECT, port, sock->error));
        break;

    case A_DELETE: // Temporary to TEST error handler!
        {
            REBVAL *event = Append_Event();     // sets signal
            VAL_SET(event, REB_EVENT);      // (has more space, if we need it)
            VAL_EVENT_TYPE(event) = EVT_ERROR;
            VAL_EVENT_DATA(event) = 101;
            VAL_EVENT_REQ(event) = sock;
        }
        break;

    default:
        fail (Error_Illegal_Action(REB_PORT, action));
    }

    return R_OUT;
}
Beispiel #5
0
*/	static REB_R Console_Actor(struct Reb_Call *call_, REBSER *port, REBCNT action)
/*
***********************************************************************/
{
	REBREQ *req;
	REBINT result;
	REBVAL *arg = D_ARG(2);
	REBSER *ser;

	Validate_Port(port, action);

	arg = D_ARG(2);
	*D_OUT = *D_ARG(1);

	req = cast(REBREQ*, Use_Port_State(port, RDI_STDIO, sizeof(REBREQ)));

	switch (action) {

	case A_READ:

		// If not open, open it:
		if (!IS_OPEN(req)) {
			if (OS_DO_DEVICE(req, RDC_OPEN)) Trap_Port_DEAD_END(RE_CANNOT_OPEN, port, req->error);
		}

		// If no buffer, create a buffer:
		arg = OFV(port, STD_PORT_DATA);
		if (!IS_STRING(arg) && !IS_BINARY(arg)) {
			Set_Binary(arg, MAKE_OS_BUFFER(OUT_BUF_SIZE));
		}
		ser = VAL_SERIES(arg);
		RESET_SERIES(ser);

		req->common.data = BIN_HEAD(ser);
		req->length = SERIES_AVAIL(ser);

#ifdef nono
		// Is the buffer large enough?
		req->length = SERIES_AVAIL(ser); // space available
		if (req->length < OUT_BUF_SIZE/2) Extend_Series(ser, OUT_BUF_SIZE);
		req->length = SERIES_AVAIL(ser);

		// Don't make buffer too large:  Bug #174   ?????
		if (req->length > 1024) req->length = 1024;  //???
		req->common.data = STR_TAIL(ser); // write at tail  //???
		if (SERIES_TAIL(ser) == 0) req->actual = 0;  //???
#endif

		result = OS_DO_DEVICE(req, RDC_READ);
		if (result < 0) Trap_Port_DEAD_END(RE_READ_ERROR, port, req->error);

#ifdef nono
		// Does not belong here!!
		// Remove or replace CRs:
		result = 0;
		for (n = 0; n < req->actual; n++) {
			chr = GET_ANY_CHAR(ser, n);
			if (chr == CR) {
				chr = LF;
				// Skip LF if it follows:
				if ((n+1) < req->actual &&
					LF == GET_ANY_CHAR(ser, n+1)) n++;
			}
			SET_ANY_CHAR(ser, result, chr);
			result++;
		}
#endif
		// !!! Among many confusions in this file, it said "Another copy???"
		//Set_String(D_OUT, Copy_OS_Str(ser->data, result));
		Set_Binary(D_OUT, Copy_Bytes(req->common.data, req->actual));
		break;

	case A_OPEN:
		// ?? why???
		//if (OS_DO_DEVICE(req, RDC_OPEN)) Trap_Port_DEAD_END(RE_CANNOT_OPEN, port);
		SET_OPEN(req);
		break;

	case A_CLOSE:
		SET_CLOSED(req);
		//OS_DO_DEVICE(req, RDC_CLOSE);
		break;

	case A_OPENQ:
		if (IS_OPEN(req)) return R_TRUE;
		return R_FALSE;

	default:
		Trap_Action_DEAD_END(REB_PORT, action);
	}

	return R_OUT;
}