*/ static void Setup_File(REBREQ *file, REBCNT args, REBVAL *path)
/*
** Convert native action refinements to file modes.
**
***********************************************************************/
{
REBSER *ser;
if (args & AM_OPEN_WRITE) SET_FLAG(file->modes, RFM_WRITE);
if (args & AM_OPEN_READ) SET_FLAG(file->modes, RFM_READ);
if (args & AM_OPEN_SEEK) SET_FLAG(file->modes, RFM_SEEK);
if (args & AM_OPEN_NEW) {
SET_FLAG(file->modes, RFM_NEW);
if (!(args & AM_OPEN_WRITE)) Trap1(RE_BAD_FILE_MODE, path);
}
// Convert file name to OS format, let it GC later.
if (!(ser = Value_To_OS_Path(path, TRUE)))
Trap1(RE_BAD_FILE_PATH, path);
file->special.file.path = cast(REBCHR*, ser->data);
SET_FLAG(file->modes, RFM_NAME_MEM);
Secure_Port(SYM_FILE, file, path, ser);
}
*/ static REB_R File_Actor(struct Reb_Call *call_, REBSER *port, REBCNT action)
/*
** Internal port handler for files.
**
***********************************************************************/
{
REBVAL *spec;
REBVAL *path;
REBREQ *file = 0;
REBCNT args = 0;
REBCNT len;
REBOOL opened = FALSE; // had to be opened (shortcut case)
//Print("FILE ACTION: %r", Get_Action_Word(action));
Validate_Port(port, action);
*D_OUT = *D_ARG(1);
// Validate PORT fields:
spec = BLK_SKIP(port, STD_PORT_SPEC);
if (!IS_OBJECT(spec)) Trap1_DEAD_END(RE_INVALID_SPEC, spec);
path = Obj_Value(spec, STD_PORT_SPEC_HEAD_REF);
if (!path) Trap1_DEAD_END(RE_INVALID_SPEC, spec);
if (IS_URL(path)) path = Obj_Value(spec, STD_PORT_SPEC_HEAD_PATH);
else if (!IS_FILE(path)) Trap1_DEAD_END(RE_INVALID_SPEC, path);
// Get or setup internal state data:
file = (REBREQ*)Use_Port_State(port, RDI_FILE, sizeof(*file));
switch (action) {
case A_READ:
args = Find_Refines(call_, ALL_READ_REFS);
// Handle the READ %file shortcut case:
if (!IS_OPEN(file)) {
REBCNT nargs = AM_OPEN_READ;
if (args & AM_READ_SEEK) nargs |= AM_OPEN_SEEK;
Setup_File(file, nargs, path);
Open_File_Port(port, file, path);
opened = TRUE;
}
if (args & AM_READ_SEEK) Set_Seek(file, D_ARG(ARG_READ_INDEX));
len = Set_Length(
file, D_REF(ARG_READ_PART) ? VAL_INT64(D_ARG(ARG_READ_LENGTH)) : -1
);
Read_File_Port(D_OUT, port, file, path, args, len);
if (opened) {
OS_DO_DEVICE(file, RDC_CLOSE);
Cleanup_File(file);
}
if (file->error) Trap_Port_DEAD_END(RE_READ_ERROR, port, file->error);
break;
case A_APPEND:
if (!(IS_BINARY(D_ARG(2)) || IS_STRING(D_ARG(2)) || IS_BLOCK(D_ARG(2))))
Trap1_DEAD_END(RE_INVALID_ARG, D_ARG(2));
file->special.file.index = file->special.file.size;
SET_FLAG(file->modes, RFM_RESEEK);
case A_WRITE:
args = Find_Refines(call_, ALL_WRITE_REFS);
spec = D_ARG(2); // data (binary, string, or block)
// Handle the READ %file shortcut case:
if (!IS_OPEN(file)) {
REBCNT nargs = AM_OPEN_WRITE;
if (args & AM_WRITE_SEEK || args & AM_WRITE_APPEND) nargs |= AM_OPEN_SEEK;
else nargs |= AM_OPEN_NEW;
Setup_File(file, nargs, path);
Open_File_Port(port, file, path);
opened = TRUE;
}
else {
if (!GET_FLAG(file->modes, RFM_WRITE)) Trap1_DEAD_END(RE_READ_ONLY, path);
}
// Setup for /append or /seek:
if (args & AM_WRITE_APPEND) {
file->special.file.index = -1; // append
SET_FLAG(file->modes, RFM_RESEEK);
}
if (args & AM_WRITE_SEEK) Set_Seek(file, D_ARG(ARG_WRITE_INDEX));
// Determine length. Clip /PART to size of string if needed.
len = VAL_LEN(spec);
if (args & AM_WRITE_PART) {
REBCNT n = Int32s(D_ARG(ARG_WRITE_LENGTH), 0);
if (n <= len) len = n;
}
Write_File_Port(file, spec, len, args);
if (opened) {
OS_DO_DEVICE(file, RDC_CLOSE);
Cleanup_File(file);
}
if (file->error) Trap1_DEAD_END(RE_WRITE_ERROR, path);
break;
case A_OPEN:
args = Find_Refines(call_, ALL_OPEN_REFS);
// Default file modes if not specified:
if (!(args & (AM_OPEN_READ | AM_OPEN_WRITE))) args |= (AM_OPEN_READ | AM_OPEN_WRITE);
Setup_File(file, args, path);
Open_File_Port(port, file, path); // !!! needs to change file modes to R/O if necessary
break;
case A_COPY:
if (!IS_OPEN(file)) Trap1_DEAD_END(RE_NOT_OPEN, path); //!!!! wrong msg
len = Set_Length(file, D_REF(2) ? VAL_INT64(D_ARG(3)) : -1);
Read_File_Port(D_OUT, port, file, path, args, len);
break;
case A_OPENQ:
if (IS_OPEN(file)) return R_TRUE;
return R_FALSE;
case A_CLOSE:
if (IS_OPEN(file)) {
OS_DO_DEVICE(file, RDC_CLOSE);
Cleanup_File(file);
}
break;
case A_DELETE:
if (IS_OPEN(file)) Trap1_DEAD_END(RE_NO_DELETE, path);
Setup_File(file, 0, path);
if (OS_DO_DEVICE(file, RDC_DELETE) < 0 ) Trap1_DEAD_END(RE_NO_DELETE, path);
break;
case A_RENAME:
if (IS_OPEN(file)) Trap1_DEAD_END(RE_NO_RENAME, path);
else {
REBSER *target;
Setup_File(file, 0, path);
// Convert file name to OS format:
if (!(target = Value_To_OS_Path(D_ARG(2), TRUE)))
Trap1_DEAD_END(RE_BAD_FILE_PATH, D_ARG(2));
file->common.data = BIN_DATA(target);
OS_DO_DEVICE(file, RDC_RENAME);
Free_Series(target);
if (file->error) Trap1_DEAD_END(RE_NO_RENAME, path);
}
break;
case A_CREATE:
// !!! should it leave file open???
if (!IS_OPEN(file)) {
Setup_File(file, AM_OPEN_WRITE | AM_OPEN_NEW, path);
if (OS_DO_DEVICE(file, RDC_CREATE) < 0) Trap_Port_DEAD_END(RE_CANNOT_OPEN, port, file->error);
OS_DO_DEVICE(file, RDC_CLOSE);
}
break;
case A_QUERY:
if (!IS_OPEN(file)) {
Setup_File(file, 0, path);
if (OS_DO_DEVICE(file, RDC_QUERY) < 0) return R_NONE;
}
Ret_Query_File(port, file, D_OUT);
// !!! free file path?
break;
case A_MODIFY:
Set_Mode_Value(file, Get_Mode_Id(D_ARG(2)), D_ARG(3));
if (!IS_OPEN(file)) {
Setup_File(file, 0, path);
if (OS_DO_DEVICE(file, RDC_MODIFY) < 0) return R_NONE;
}
return R_TRUE;
break;
case A_INDEXQ:
SET_INTEGER(D_OUT, file->special.file.index + 1);
break;
case A_LENGTHQ:
SET_INTEGER(D_OUT, file->special.file.size - file->special.file.index); // !clip at zero
break;
case A_HEAD:
file->special.file.index = 0;
goto seeked;
case A_TAIL:
file->special.file.index = file->special.file.size;
goto seeked;
case A_NEXT:
file->special.file.index++;
goto seeked;
case A_BACK:
if (file->special.file.index > 0) file->special.file.index--;
goto seeked;
case A_SKIP:
file->special.file.index += Get_Num_Arg(D_ARG(2));
goto seeked;
case A_HEADQ:
DECIDE(file->special.file.index == 0);
case A_TAILQ:
DECIDE(file->special.file.index >= file->special.file.size);
case A_PASTQ:
DECIDE(file->special.file.index > file->special.file.size);
case A_CLEAR:
// !! check for write enabled?
SET_FLAG(file->modes, RFM_RESEEK);
SET_FLAG(file->modes, RFM_TRUNCATE);
file->length = 0;
if (OS_DO_DEVICE(file, RDC_WRITE) < 0) Trap1_DEAD_END(RE_WRITE_ERROR, path);
break;
/* Not yet implemented:
A_AT, // 38
A_PICK, // 41
A_PATH, // 42
A_PATH_SET, // 43
A_FIND, // 44
A_SELECT, // 45
A_TAKE, // 49
A_INSERT, // 50
A_REMOVE, // 52
A_CHANGE, // 53
A_POKE, // 54
A_QUERY, // 64
A_FLUSH, // 65
*/
default:
Trap_Action_DEAD_END(REB_PORT, action);
}
return R_OUT;
seeked:
SET_FLAG(file->modes, RFM_RESEEK);
return R_ARG1;
is_true:
return R_TRUE;
is_false:
return R_FALSE;
}
*/ static int Dir_Actor(REBVAL *ds, REBSER *port, REBCNT action)
/*
** Internal port handler for file directories.
**
***********************************************************************/
{
REBVAL *spec;
REBVAL *path;
REBVAL *state;
REBREQ dir;
REBCNT args = 0;
REBINT result;
REBCNT len;
//REBYTE *flags;
Validate_Port(port, action);
*D_RET = *D_ARG(1);
CLEARS(&dir);
// Validate and fetch relevant PORT fields:
spec = BLK_SKIP(port, STD_PORT_SPEC);
if (!IS_OBJECT(spec)) Trap1(RE_INVALID_SPEC, spec);
path = Obj_Value(spec, STD_PORT_SPEC_HEAD_REF);
if (!path) Trap1(RE_INVALID_SPEC, spec);
if (IS_URL(path)) path = Obj_Value(spec, STD_PORT_SPEC_HEAD_PATH);
else if (!IS_FILE(path)) Trap1(RE_INVALID_SPEC, path);
state = BLK_SKIP(port, STD_PORT_STATE); // if block, then port is open.
//flags = Security_Policy(SYM_FILE, path);
// Get or setup internal state data:
dir.port = port;
dir.device = RDI_FILE;
switch (action) {
case A_READ:
//Trap_Security(flags[POL_READ], POL_READ, path);
args = Find_Refines(ds, ALL_READ_REFS);
if (!IS_BLOCK(state)) { // !!! ignores /SKIP and /PART, for now
Init_Dir_Path(&dir, path, 1, POL_READ);
Set_Block(state, Make_Block(7)); // initial guess
result = Read_Dir(&dir, VAL_SERIES(state));
///OS_FREE(dir.file.path);
if (result < 0) Trap_Port(RE_CANNOT_OPEN, port, dir.error);
*D_RET = *state;
SET_NONE(state);
} else {
len = VAL_BLK_LEN(state);
// !!? Why does this need to copy the block??
Set_Block(D_RET, Copy_Block_Values(VAL_SERIES(state), 0, len, TS_STRING));
}
break;
case A_CREATE:
//Trap_Security(flags[POL_WRITE], POL_WRITE, path);
if (IS_BLOCK(state)) Trap1(RE_ALREADY_OPEN, path); // already open
create:
Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too
result = OS_DO_DEVICE(&dir, RDC_CREATE);
///OS_FREE(dir.file.path);
if (result < 0) Trap1(RE_NO_CREATE, path);
if (action == A_CREATE) return R_ARG2;
SET_NONE(state);
break;
case A_RENAME:
if (IS_BLOCK(state)) Trap1(RE_ALREADY_OPEN, path); // already open
else {
REBSER *target;
Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too
// Convert file name to OS format:
if (!(target = Value_To_OS_Path(D_ARG(2)))) Trap1(RE_BAD_FILE_PATH, D_ARG(2));
dir.data = BIN_DATA(target);
OS_DO_DEVICE(&dir, RDC_RENAME);
Free_Series(target);
if (dir.error) Trap1(RE_NO_RENAME, path);
}
break;
case A_DELETE:
//Trap_Security(flags[POL_WRITE], POL_WRITE, path);
SET_NONE(state);
Init_Dir_Path(&dir, path, 0, POL_WRITE);
// !!! add *.r deletion
// !!! add recursive delete (?)
result = OS_DO_DEVICE(&dir, RDC_DELETE);
///OS_FREE(dir.file.path);
if (result < 0) Trap1(RE_NO_DELETE, path);
return R_ARG2;
case A_OPEN:
// !! If open fails, what if user does a READ w/o checking for error?
if (IS_BLOCK(state)) Trap1(RE_ALREADY_OPEN, path); // already open
//Trap_Security(flags[POL_READ], POL_READ, path);
args = Find_Refines(ds, ALL_OPEN_REFS);
if (args & AM_OPEN_NEW) goto create;
//if (args & ~AM_OPEN_READ) Trap1(RE_INVALID_SPEC, path);
Set_Block(state, Make_Block(7));
Init_Dir_Path(&dir, path, 1, POL_READ);
result = Read_Dir(&dir, VAL_SERIES(state));
///OS_FREE(dir.file.path);
if (result < 0) Trap_Port(RE_CANNOT_OPEN, port, dir.error);
break;
case A_OPENQ:
if (IS_BLOCK(state)) return R_TRUE;
return R_FALSE;
case A_CLOSE:
SET_NONE(state);
break;
case A_QUERY:
//Trap_Security(flags[POL_READ], POL_READ, path);
SET_NONE(state);
Init_Dir_Path(&dir, path, -1, REMOVE_TAIL_SLASH | POL_READ);
if (OS_DO_DEVICE(&dir, RDC_QUERY) < 0) return R_NONE;
Ret_Query_File(port, &dir, D_RET);
///OS_FREE(dir.file.path);
break;
//-- Port Series Actions (only called if opened as a port)
case A_LENGTHQ:
len = IS_BLOCK(state) ? VAL_BLK_LEN(state) : 0;
SET_INTEGER(D_RET, len);
break;
default:
Trap_Action(REB_PORT, action);
}
return R_RET;
}
*/ static void Init_Dir_Path(REBREQ *dir, REBVAL *path, REBINT wild, REBCNT policy)
/*
** Convert REBOL dir path to file system path.
** On Windows, we will also need to append a * if necessary.
**
** ARGS:
** Wild:
** 0 - no wild cards, path must end in / else error
** 1 - accept wild cards * and ?, and * if need
** -1 - not wild, if path does not end in /, add it
**
***********************************************************************/
{
REBINT len;
REBSER *ser;
//REBYTE *flags;
SET_FLAG(dir->modes, RFM_DIR);
// We depend on To_Local_Path giving us 2 extra chars for / and *
ser = Value_To_OS_Path(path);
len = ser->tail;
dir->file.path = (REBCHR*)(ser->data);
Secure_Port(SYM_FILE, dir, path, ser);
if (len == 1 && dir->file.path[0] == '.') {
if (wild > 0) {
dir->file.path[0] = '*';
dir->file.path[1] = 0;
}
}
else if (len == 2 && dir->file.path[0] == '.' && dir->file.path[1] == '.') {
// Insert * if needed:
if (wild > 0) {
dir->file.path[len++] = '/';
dir->file.path[len++] = '*';
dir->file.path[len] = 0;
}
}
else if (dir->file.path[len-1] == '/' || dir->file.path[len-1] == '\\') {
if (policy & REMOVE_TAIL_SLASH) {
dir->file.path[len-1] = 0;
}
else {
// Insert * if needed:
if (wild > 0) {
dir->file.path[len++] = '*';
dir->file.path[len] = 0;
}
}
} else {
// Path did not end with /, so we better be wild:
if (wild == 0) {
///OS_FREE(dir->file.path);
Trap1(RE_BAD_FILE_PATH, path);
}
else if (wild < 0) {
dir->file.path[len++] = OS_DIR_SEP;
dir->file.path[len] = 0;
}
}
}
*/ static void Init_Dir_Path(REBREQ *dir, REBVAL *path, REBINT wild, REBCNT policy)
/*
** Convert REBOL dir path to file system path.
** On Windows, we will also need to append a * if necessary.
**
** ARGS:
** Wild:
** 0 - no wild cards, path must end in / else error
** 1 - accept wild cards * and ?, and * if need
** -1 - not wild, if path does not end in /, add it
**
***********************************************************************/
{
REBINT len;
REBSER *ser;
//REBYTE *flags;
SET_FLAG(dir->modes, RFM_DIR);
// We depend on To_Local_Path giving us 2 extra chars for / and *
ser = Value_To_OS_Path(path, TRUE);
len = ser->tail;
dir->special.file.path = cast(REBCHR*, ser->data);
Secure_Port(SYM_FILE, dir, path, ser);
if (len == 1 && OS_CH_EQUAL(dir->special.file.path[0], '.')) {
if (wild > 0) {
dir->special.file.path[0] = OS_MAKE_CH('*');
dir->special.file.path[1] = OS_MAKE_CH('\0');
}
}
else if (
len == 2
&& OS_CH_EQUAL(dir->special.file.path[0], '.')
&& OS_CH_EQUAL(dir->special.file.path[1], '.')
) {
// Insert * if needed:
if (wild > 0) {
dir->special.file.path[len++] = OS_MAKE_CH('/');
dir->special.file.path[len++] = OS_MAKE_CH('*');
dir->special.file.path[len] = OS_MAKE_CH('\0');
}
}
else if (
OS_CH_EQUAL(dir->special.file.path[len-1], '/')
|| OS_CH_EQUAL(dir->special.file.path[len-1], '\\')
) {
if (policy & REMOVE_TAIL_SLASH) {
dir->special.file.path[len-1] = OS_MAKE_CH('\0');
}
else {
// Insert * if needed:
if (wild > 0) {
dir->special.file.path[len++] = OS_MAKE_CH('*');
dir->special.file.path[len] = OS_MAKE_CH('\0');
}
}
} else {
// Path did not end with /, so we better be wild:
if (wild == 0) {
// !!! Comment said `OS_FREE(dir->special.file.path);` (needed?)
raise Error_1(RE_BAD_FILE_PATH, path);
}
else if (wild < 0) {
dir->special.file.path[len++] = OS_MAKE_CH(OS_DIR_SEP);
dir->special.file.path[len] = OS_MAKE_CH('\0');
}
}
}
*/ static REB_R Dir_Actor(struct Reb_Call *call_, REBSER *port, REBCNT action)
/*
** Internal port handler for file directories.
**
***********************************************************************/
{
REBVAL *spec;
REBVAL *path;
REBVAL *state;
REBREQ dir;
REBCNT args = 0;
REBINT result;
REBCNT len;
//REBYTE *flags;
Validate_Port(port, action);
*D_OUT = *D_ARG(1);
CLEARS(&dir);
// Validate and fetch relevant PORT fields:
spec = BLK_SKIP(port, STD_PORT_SPEC);
if (!IS_OBJECT(spec)) raise Error_1(RE_INVALID_SPEC, spec);
path = Obj_Value(spec, STD_PORT_SPEC_HEAD_REF);
if (!path) raise Error_1(RE_INVALID_SPEC, spec);
if (IS_URL(path)) path = Obj_Value(spec, STD_PORT_SPEC_HEAD_PATH);
else if (!IS_FILE(path)) raise Error_1(RE_INVALID_SPEC, path);
state = BLK_SKIP(port, STD_PORT_STATE); // if block, then port is open.
//flags = Security_Policy(SYM_FILE, path);
// Get or setup internal state data:
dir.port = port;
dir.device = RDI_FILE;
switch (action) {
case A_READ:
//Trap_Security(flags[POL_READ], POL_READ, path);
args = Find_Refines(call_, ALL_READ_REFS);
if (!IS_BLOCK(state)) { // !!! ignores /SKIP and /PART, for now
Init_Dir_Path(&dir, path, 1, POL_READ);
Val_Init_Block(state, Make_Array(7)); // initial guess
result = Read_Dir(&dir, VAL_SERIES(state));
///OS_FREE(dir.file.path);
if (result < 0)
raise Error_On_Port(RE_CANNOT_OPEN, port, dir.error);
*D_OUT = *state;
SET_NONE(state);
}
else {
// !!! This copies the strings in the block, shallowly. What is
// the purpose of doing this? Why copy at all?
Val_Init_Block(
D_OUT,
Copy_Array_Core_Managed(
VAL_SERIES(state),
0,
VAL_BLK_LEN(state),
FALSE, // !deep
TS_STRING
)
);
}
break;
case A_CREATE:
//Trap_Security(flags[POL_WRITE], POL_WRITE, path);
if (IS_BLOCK(state)) raise Error_1(RE_ALREADY_OPEN, path);
create:
Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too
result = OS_DO_DEVICE(&dir, RDC_CREATE);
///OS_FREE(dir.file.path);
if (result < 0) raise Error_1(RE_NO_CREATE, path);
if (action == A_CREATE) {
// !!! Used to return R_ARG2, but create is single arity. :-/
return R_ARG1;
}
SET_NONE(state);
break;
case A_RENAME:
if (IS_BLOCK(state)) raise Error_1(RE_ALREADY_OPEN, path);
else {
REBSER *target;
Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too
// Convert file name to OS format:
if (!(target = Value_To_OS_Path(D_ARG(2), TRUE)))
raise Error_1(RE_BAD_FILE_PATH, D_ARG(2));
dir.common.data = BIN_DATA(target);
OS_DO_DEVICE(&dir, RDC_RENAME);
Free_Series(target);
if (dir.error) raise Error_1(RE_NO_RENAME, path);
}
break;
case A_DELETE:
//Trap_Security(flags[POL_WRITE], POL_WRITE, path);
SET_NONE(state);
Init_Dir_Path(&dir, path, 0, POL_WRITE);
// !!! add *.r deletion
// !!! add recursive delete (?)
result = OS_DO_DEVICE(&dir, RDC_DELETE);
///OS_FREE(dir.file.path);
if (result < 0) raise Error_1(RE_NO_DELETE, path);
// !!! Returned R_ARG2 before, but there is no second argument :-/
return R_ARG1;
case A_OPEN:
// !! If open fails, what if user does a READ w/o checking for error?
if (IS_BLOCK(state)) raise Error_1(RE_ALREADY_OPEN, path);
//Trap_Security(flags[POL_READ], POL_READ, path);
args = Find_Refines(call_, ALL_OPEN_REFS);
if (args & AM_OPEN_NEW) goto create;
//if (args & ~AM_OPEN_READ) raise Error_1(RE_INVALID_SPEC, path);
Val_Init_Block(state, Make_Array(7));
Init_Dir_Path(&dir, path, 1, POL_READ);
result = Read_Dir(&dir, VAL_SERIES(state));
///OS_FREE(dir.file.path);
if (result < 0) raise Error_On_Port(RE_CANNOT_OPEN, port, dir.error);
break;
case A_OPENQ:
if (IS_BLOCK(state)) return R_TRUE;
return R_FALSE;
case A_CLOSE:
SET_NONE(state);
break;
case A_QUERY:
//Trap_Security(flags[POL_READ], POL_READ, path);
SET_NONE(state);
Init_Dir_Path(&dir, path, -1, REMOVE_TAIL_SLASH | POL_READ);
if (OS_DO_DEVICE(&dir, RDC_QUERY) < 0) return R_NONE;
Ret_Query_File(port, &dir, D_OUT);
///OS_FREE(dir.file.path);
break;
//-- Port Series Actions (only called if opened as a port)
case A_LENGTH:
len = IS_BLOCK(state) ? VAL_BLK_LEN(state) : 0;
SET_INTEGER(D_OUT, len);
break;
default:
raise Error_Illegal_Action(REB_PORT, action);
}
return R_OUT;
}
