Re: File ops on a VFS mounted file

On Mon, 21 Apr 2025 16:36:28 +1000
Scott Pitcher <scotty@svptechnicalservices.com.au> wrote:
I took a simpler approeach and I wrote a simple extension in an hour and
since tested on Linux and Windows. Reads the file off disk using old
fashioned fopen(), fread() etc. Works fine and when running inside a VFS
attached to an EXE file it's completely fine to use this method. This
felt like a silly solution as Tcl doesn't seem to offer any other way
of reading the raw file from local FS. Would be nice if "open" had a
-novfs option, or if I could prefix a url with something like
"file://..." or "local://..." to steer it away from VFS. or
alternately, if the VFS extension treated an [open ...] of the VFS
container itself as opening the container file not the VFS directory,
that would also suffice. Actually I think this last one should be the
normal behaviour. For now, dumpfile works:

/*
 * The dumpfile Tcl command. Open the file on the local file system in binary mode, and return
 * the contents.
 * Pre:
 * Module is initialised.
 * Params:
 * ClientData dummy, |Tcl command parameters.
 * Tcl_Interp *interp, |
 * int objc, |
 * Tcl_Obj *CONST objv[] |
 * Tcl Params:
 * fileName |File name to source.
 * Returns:
 * TCL_OK if successful with the file binary contents left in the interpreter result, else
 * TCL_ERROR with the error message left in the interpreter result.
 * Post:
 * none.
 */
static int DumpfileCommand(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    int i, result = TCL_OK, nargs = 0;
    const char *opt;
    Tcl_Obj *infile, *data;
    FILE *fp = NULL;
    struct stat statbuf;
    unsigned char *buf;

    /*
     * Parse command line.
     */
    i = 1;
    while (i < objc) {
opt = Tcl_GetString(objv[i]);
if (opt[0] == '-') {
    /*
     * Parameters.
     */
    Tcl_AppendResult(interp, "invalid option: \"", opt, "\"", NULL);
    goto failed;

} else {
    /*
     * Arguments: must be the filename.
     */
    infile = objv[i];
    ++nargs;
}
++i;
    }

    if (nargs != 1) {
Tcl_AppendResult(interp, "missing or invalid filename argument", NULL);
goto failed;
    }

    /*
     * We need to know if the file exists and it's size.
     */
    if (stat(Tcl_GetString(infile), &statbuf) != 0) {
Tcl_AppendResult(interp,"could not stat file, does it exist? : ", strerror(errno), NULL);
goto failed;
    }

    /*
     * Try to open the file, and bail out on any error.
     */
    if ((fp = fopen(Tcl_GetString(infile), "rb")) == NULL) {
Tcl_AppendResult(interp,"file open failed: ", strerror(errno), NULL);
goto failed;
    }

    /*
     * Now allocate a buffer, read in the file, and then return the result.
     */
    buf = ckalloc(statbuf.st_size);
    if (fread(buf,1,statbuf.st_size,fp) != statbuf.st_size) {
Tcl_AppendResult(interp,"file read failed: ", strerror(errno), NULL);
goto failed;
    }
    data = Tcl_NewObj();
    Tcl_IncrRefCount(data);
    Tcl_SetByteArrayObj(data, buf, statbuf.st_size);
    Tcl_SetObjResult(interp, data);
    Tcl_DecrRefCount(data);

    goto clean_n_return;

failed:
    result = TCL_ERROR;
clean_n_return:
    if (fp != NULL)
fclose(fp);
    return result;
}

On Mon, 21 Apr 2025 10:56:44 +0530
Ashok <apnmbx-public@yahoo.com> wrote:
 
I did try a simple test before I emailed, where argv0 and [info
nameofexecutable] are the same thing -
 
set fdin [open $argv0 "rb"]
set fdout [open $opts(1) "wb"]
puts -nonewline $fdout [read $fdin]
 
- but this fails because $argv0 is already mounted automatically when
the executable is first run. Trying to open $argv0 is interpreted as
attempting to open a directory for reading.
 
I'm looking at mk4tcl... source now and particularly mk4tcl.cpp. It
might be easier to expose either a binary dump of the file or handle
access.
 
Kind regards,
Scott
 
 
 

Perhaps you can exec [info nameofexecutable] itself to do the copy
in a cross-platform manner? Either (obviously untested)
 
set fd [open |[info nameofexecutable]...
puts $fd [list file copy [info nameofexecutable] target]
 
or
 
exec [info nameofexecutable] [file join [info nameofexecutable]
yourcopyscript.tcl]
 
where youcopyscript is a Tcl script within your VFS that does
the copy.
 
Perhaps someone will suggest a simple way ...
 
/Ashok
 
 
 
On 4/21/2025 7:12 AM, Scott Pitcher wrote: 

Hi,
I've got some executables built with kbskit on Windows and Linux,
and I'm trying to get one of them to copy itself to another file,
as part of initialising a new VFS for an end user application.
The VFS was created with vlerq by kbs.tcl.
When the exetuable VFS attempts to copy itself to the target image
(opts(1) == the target file name) -
 
   if {[catch "file copy $extraarg $argv0 $opts(1)" output
ropts]} { ErrorExit 1 "init: failed to create target VFS
\"$argv0\": $output" }
 
I get the error:
 
   failed to create target VFS "...": can't overwrite file "..."
with directory
 
- because of course the VFS is also mounted and my script is
running inside of that.
 
I tried using [open ...] and [puts ... [read ..]] but the VFS
image file can't be opened while it's mounted.
 
I was able to successfully use [exec cp......], but external tools
probably won't be available on the end user systems and certainly
not on MS Windows.
 
But if the VFS is mounted then it's already been opened by the VFS
library itself. Perhaps there is a way of duplicating the file
handle or accessing the naked VFS image file without invoking the
VFS library?
 
Kind regards,
Scott