stand/ficl/fileaccess.c

   1
   2 #include <errno.h>
   3 #include <stdlib.h>
   4 #include <stdio.h>
   5 #include <string.h>
   6 #include <ctype.h>
   7 #include <sys/stat.h>
   8 #include "ficl.h"
   9
  10 #if FICL_WANT_FILE
  11 /*
  12 **
  13 ** fileaccess.c
  14 **
  15 ** Implements all of the File Access word set that can be implemented in portable C.
  16 **
  17 */
  18
  19 static void pushIor(FICL_VM *pVM, int success)
  20 {
  21     int ior;
  22     if (success)
  23         ior = 0;
  24     else
  25         ior = errno;
  26     stackPushINT(pVM->pStack, ior);
  27 }
  28
  29
  30
  31 static void ficlFopen(FICL_VM *pVM, char *writeMode) /* ( c-addr u fam -- fileid ior ) */
  32 {
  33     int fam = stackPopINT(pVM->pStack);
  34     int length = stackPopINT(pVM->pStack);
  35     void *address = (void *)stackPopPtr(pVM->pStack);
  36     char mode[4];
  37     FILE *f;
  38
  39     char *filename = (char *)alloca(length + 1);
  40     memcpy(filename, address, length);
  41     filename[length] = 0;
  42
  43     *mode = 0;
  44
  45     switch (FICL_FAM_OPEN_MODE(fam))
  46         {
  47         case 0:
  48             stackPushPtr(pVM->pStack, NULL);
  49             stackPushINT(pVM->pStack, EINVAL);
  50             return;
  51         case FICL_FAM_READ:
  52             strcat(mode, "r");
  53             break;
  54         case FICL_FAM_WRITE:
  55             strcat(mode, writeMode);
  56             break;
  57         case FICL_FAM_READ | FICL_FAM_WRITE:
  58             strcat(mode, writeMode);
  59             strcat(mode, "+");
  60             break;
  61         }
  62
  63     strcat(mode, (fam & FICL_FAM_BINARY) ? "b" : "t");
  64
  65     f = fopen(filename, mode);
  66     if (f == NULL)
  67         stackPushPtr(pVM->pStack, NULL);
  68     else
  69 #ifdef LOADER_VERIEXEC
  70         if (*mode == 'r' &&
  71             verify_file(fileno(f), filename, 0, VE_GUESS, __func__) < 0) {
  72             fclose(f);
  73             stackPushPtr(pVM->pStack, NULL);
  74         } else
  75 #endif
  76         {
  77             ficlFILE *ff = (ficlFILE *)malloc(sizeof(ficlFILE));
  78             strcpy(ff->filename, filename);
  79             ff->f = f;
  80             stackPushPtr(pVM->pStack, ff);
  81
  82             fseek(f, 0, SEEK_SET);
  83         }
  84     pushIor(pVM, f != NULL);
  85 }
  86
  87
  88
  89 static void ficlOpenFile(FICL_VM *pVM) /* ( c-addr u fam -- fileid ior ) */
  90 {
  91     ficlFopen(pVM, "a");
  92 }
  93
  94
  95 static void ficlCreateFile(FICL_VM *pVM) /* ( c-addr u fam -- fileid ior ) */
  96 {
  97     ficlFopen(pVM, "w");
  98 }
  99
 100
 101 static int closeFiclFILE(ficlFILE *ff) /* ( fileid -- ior ) */
 102 {
 103     FILE *f = ff->f;
 104     free(ff);
 105     return !fclose(f);
 106 }
 107
 108 static void ficlCloseFile(FICL_VM *pVM) /* ( fileid -- ior ) */
 109 {
 110     ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
 111     pushIor(pVM, closeFiclFILE(ff));
 112 }
 113
 114 static void ficlDeleteFile(FICL_VM *pVM) /* ( c-addr u -- ior ) */
 115 {
 116     int length = stackPopINT(pVM->pStack);
 117     void *address = (void *)stackPopPtr(pVM->pStack);
 118
 119     char *filename = (char *)alloca(length + 1);
 120     memcpy(filename, address, length);
 121     filename[length] = 0;
 122
 123     pushIor(pVM, !unlink(filename));
 124 }
 125
 126 static void ficlRenameFile(FICL_VM *pVM) /* ( c-addr1 u1 c-addr2 u2 -- ior ) */
 127 {
 128     int length;
 129     void *address;
 130     char *from;
 131     char *to;
 132
 133     length = stackPopINT(pVM->pStack);
 134     address = (void *)stackPopPtr(pVM->pStack);
 135     to = (char *)alloca(length + 1);
 136     memcpy(to, address, length);
 137     to[length] = 0;
 138
 139     length = stackPopINT(pVM->pStack);
 140     address = (void *)stackPopPtr(pVM->pStack);
 141
 142     from = (char *)alloca(length + 1);
 143     memcpy(from, address, length);
 144     from[length] = 0;
 145
 146     pushIor(pVM, !rename(from, to));
 147 }
 148
 149 static void ficlFileStatus(FICL_VM *pVM) /* ( c-addr u -- x ior ) */
 150 {
 151     struct stat statbuf;
 152
 153     int length = stackPopINT(pVM->pStack);
 154     void *address = (void *)stackPopPtr(pVM->pStack);
 155
 156     char *filename = (char *)alloca(length + 1);
 157     memcpy(filename, address, length);
 158     filename[length] = 0;
 159
 160     if (stat(filename, &statbuf) == 0)
 161     {
 162         /*
 163         ** the "x" left on the stack is implementation-defined.
 164         ** I push the file's access mode (readable, writeable, is directory, etc)
 165         ** as defined by ANSI C.
 166         */
 167         stackPushINT(pVM->pStack, statbuf.st_mode);
 168         stackPushINT(pVM->pStack, 0);
 169     }
 170     else
 171     {
 172         stackPushINT(pVM->pStack, -1);
 173         stackPushINT(pVM->pStack, ENOENT);
 174     }
 175 }
 176
 177
 178 static void ficlFilePosition(FICL_VM *pVM) /* ( fileid -- ud ior ) */
 179 {
 180     ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
 181     long ud = ftell(ff->f);
 182     stackPushINT(pVM->pStack, ud);
 183     pushIor(pVM, ud != -1);
 184 }
 185
 186
 187
 188 static long fileSize(FILE *f)
 189 {
 190     struct stat statbuf;
 191     statbuf.st_size = -1;
 192     if (fstat(fileno(f), &statbuf) != 0)
 193         return -1;
 194     return statbuf.st_size;
 195 }
 196
 197
 198
 199 static void ficlFileSize(FICL_VM *pVM) /* ( fileid -- ud ior ) */
 200 {
 201     ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
 202     long ud = fileSize(ff->f);
 203     stackPushINT(pVM->pStack, ud);
 204     pushIor(pVM, ud != -1);
 205 }
 206
 207
 208
 209 #define nLINEBUF 256
 210 static void ficlIncludeFile(FICL_VM *pVM) /* ( i*x fileid -- j*x ) */
 211 {
 212     ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
 213     CELL id = pVM->sourceID;
 214     int     result = VM_OUTOFTEXT;
 215     long currentPosition, totalSize;
 216     long size;
 217     pVM->sourceID.p = (void *)ff;
 218
 219     currentPosition = ftell(ff->f);
 220     totalSize = fileSize(ff->f);
 221     size = totalSize - currentPosition;
 222
 223     if ((totalSize != -1) && (currentPosition != -1) && (size > 0))
 224         {
 225         char *buffer = (char *)malloc(size);
 226         long got = fread(buffer, 1, size, ff->f);
 227         if (got == size)
 228             result = ficlExecC(pVM, buffer, size);
 229         }
 230
 231 #if 0
 232     ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
 233     CELL id = pVM->sourceID;
 234     char    cp[nLINEBUF];
 235     int     nLine = 0;
 236     int     keepGoing;
 237     int     result;
 238     pVM->sourceID.p = (void *)ff;
 239
 240     /* feed each line to ficlExec */
 241     keepGoing = TRUE;
 242     while (keepGoing && fgets(cp, nLINEBUF, ff->f))
 243     {
 244         int len = strlen(cp) - 1;
 245
 246         nLine++;
 247         if (len <= 0)
 248             continue;
 249
 250         if (cp[len] == '\n')
 251             cp[len] = '\0';
 252
 253         result = ficlExec(pVM, cp);
 254
 255         switch (result)
 256         {
 257             case VM_OUTOFTEXT:
 258             case VM_USEREXIT:
 259                 break;
 260
 261             default:
 262                 pVM->sourceID = id;
 263                 keepGoing = FALSE;
 264                 break;
 265         }
 266     }
 267 #endif /* 0 */
 268     /*
 269     ** Pass an empty line with SOURCE-ID == -1 to flush
 270     ** any pending REFILLs (as required by FILE wordset)
 271     */
 272     pVM->sourceID.i = -1;
 273     ficlExec(pVM, "");
 274
 275     pVM->sourceID = id;
 276     closeFiclFILE(ff);
 277 }
 278
 279
 280
 281 static void ficlReadFile(FICL_VM *pVM) /* ( c-addr u1 fileid -- u2 ior ) */
 282 {
 283     ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
 284     int length = stackPopINT(pVM->pStack);
 285     void *address = (void *)stackPopPtr(pVM->pStack);
 286     int result;
 287
 288     clearerr(ff->f);
 289     result = fread(address, 1, length, ff->f);
 290
 291     stackPushINT(pVM->pStack, result);
 292     pushIor(pVM, ferror(ff->f) == 0);
 293 }
 294
 295
 296
 297 static void ficlReadLine(FICL_VM *pVM) /* ( c-addr u1 fileid -- u2 flag ior ) */
 298 {
 299     ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
 300     int length = stackPopINT(pVM->pStack);
 301     char *address = (char *)stackPopPtr(pVM->pStack);
 302     int error;
 303     int flag;
 304
 305     if (feof(ff->f))
 306         {
 307         stackPushINT(pVM->pStack, -1);
 308         stackPushINT(pVM->pStack, 0);
 309         stackPushINT(pVM->pStack, 0);
 310         return;
 311         }
 312
 313     clearerr(ff->f);
 314     *address = 0;
 315     fgets(address, length, ff->f);
 316
 317     error = ferror(ff->f);
 318     if (error != 0)
 319         {
 320         stackPushINT(pVM->pStack, -1);
 321         stackPushINT(pVM->pStack, 0);
 322         stackPushINT(pVM->pStack, error);
 323         return;
 324         }
 325
 326     length = strlen(address);
 327     flag = (length > 0);
 328     if (length && ((address[length - 1] == '\r') || (address[length - 1] == '\n')))
 329         length--;
 330
 331     stackPushINT(pVM->pStack, length);
 332     stackPushINT(pVM->pStack, flag);
 333     stackPushINT(pVM->pStack, 0); /* ior */
 334 }
 335
 336
 337
 338 static void ficlWriteFile(FICL_VM *pVM) /* ( c-addr u1 fileid -- ior ) */
 339 {
 340     ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
 341     int length = stackPopINT(pVM->pStack);
 342     void *address = (void *)stackPopPtr(pVM->pStack);
 343
 344     clearerr(ff->f);
 345     fwrite(address, 1, length, ff->f);
 346     pushIor(pVM, ferror(ff->f) == 0);
 347 }
 348
 349
 350
 351 static void ficlWriteLine(FICL_VM *pVM) /* ( c-addr u1 fileid -- ior ) */
 352 {
 353     ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
 354     size_t length = (size_t)stackPopINT(pVM->pStack);
 355     void *address = (void *)stackPopPtr(pVM->pStack);
 356
 357     clearerr(ff->f);
 358     if (fwrite(address, 1, length, ff->f) == length)
 359         fwrite("\n", 1, 1, ff->f);
 360     pushIor(pVM, ferror(ff->f) == 0);
 361 }
 362
 363
 364
 365 static void ficlRepositionFile(FICL_VM *pVM) /* ( ud fileid -- ior ) */
 366 {
 367     ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
 368     size_t ud = (size_t)stackPopINT(pVM->pStack);
 369
 370     pushIor(pVM, fseek(ff->f, ud, SEEK_SET) == 0);
 371 }
 372
 373
 374
 375 static void ficlFlushFile(FICL_VM *pVM) /* ( fileid -- ior ) */
 376 {
 377     ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
 378     pushIor(pVM, fflush(ff->f) == 0);
 379 }
 380
 381
 382
 383 #if FICL_HAVE_FTRUNCATE
 384
 385 static void ficlResizeFile(FICL_VM *pVM) /* ( ud fileid -- ior ) */
 386 {
 387     ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
 388     size_t ud = (size_t)stackPopINT(pVM->pStack);
 389
 390     pushIor(pVM, ftruncate(fileno(ff->f), ud) == 0);
 391 }
 392
 393 #endif /* FICL_HAVE_FTRUNCATE */
 394
 395 #endif /* FICL_WANT_FILE */
 396
 397
 398
 399 void ficlCompileFile(FICL_SYSTEM *pSys)
 400 {
 401 #if FICL_WANT_FILE
 402     FICL_DICT *dp = pSys->dp;
 403     assert(dp);
 404
 405     dictAppendWord(dp, "create-file", ficlCreateFile,  FW_DEFAULT);
 406     dictAppendWord(dp, "open-file", ficlOpenFile,  FW_DEFAULT);
 407     dictAppendWord(dp, "close-file", ficlCloseFile,  FW_DEFAULT);
 408     dictAppendWord(dp, "include-file", ficlIncludeFile,  FW_DEFAULT);
 409     dictAppendWord(dp, "read-file", ficlReadFile,  FW_DEFAULT);
 410     dictAppendWord(dp, "read-line", ficlReadLine,  FW_DEFAULT);
 411     dictAppendWord(dp, "write-file", ficlWriteFile,  FW_DEFAULT);
 412     dictAppendWord(dp, "write-line", ficlWriteLine,  FW_DEFAULT);
 413     dictAppendWord(dp, "file-position", ficlFilePosition,  FW_DEFAULT);
 414     dictAppendWord(dp, "file-size", ficlFileSize,  FW_DEFAULT);
 415     dictAppendWord(dp, "reposition-file", ficlRepositionFile,  FW_DEFAULT);
 416     dictAppendWord(dp, "file-status", ficlFileStatus,  FW_DEFAULT);
 417     dictAppendWord(dp, "flush-file", ficlFlushFile,  FW_DEFAULT);
 418
 419     dictAppendWord(dp, "delete-file", ficlDeleteFile,  FW_DEFAULT);
 420     dictAppendWord(dp, "rename-file", ficlRenameFile,  FW_DEFAULT);
 421
 422 #ifdef FICL_HAVE_FTRUNCATE
 423     dictAppendWord(dp, "resize-file", ficlResizeFile,  FW_DEFAULT);
 424
 425     ficlSetEnv(pSys, "file", FICL_TRUE);
 426     ficlSetEnv(pSys, "file-ext", FICL_TRUE);
 427 #endif /* FICL_HAVE_FTRUNCATE */
 428 #else
 429     (void)pSys;
 430 #endif /* FICL_WANT_FILE */
 431 }