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
pushIor(FICL_VM * pVM,int success)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
ficlFopen(FICL_VM * pVM,char * writeMode)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
ficlOpenFile(FICL_VM * pVM)89 static void ficlOpenFile(FICL_VM *pVM) /* ( c-addr u fam -- fileid ior ) */
90 {
91 ficlFopen(pVM, "a");
92 }
93
94
ficlCreateFile(FICL_VM * pVM)95 static void ficlCreateFile(FICL_VM *pVM) /* ( c-addr u fam -- fileid ior ) */
96 {
97 ficlFopen(pVM, "w");
98 }
99
100
closeFiclFILE(ficlFILE * ff)101 static int closeFiclFILE(ficlFILE *ff) /* ( fileid -- ior ) */
102 {
103 FILE *f = ff->f;
104 free(ff);
105 return !fclose(f);
106 }
107
ficlCloseFile(FICL_VM * pVM)108 static void ficlCloseFile(FICL_VM *pVM) /* ( fileid -- ior ) */
109 {
110 ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack);
111 pushIor(pVM, closeFiclFILE(ff));
112 }
113
ficlDeleteFile(FICL_VM * pVM)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
ficlRenameFile(FICL_VM * pVM)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
ficlFileStatus(FICL_VM * pVM)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
ficlFilePosition(FICL_VM * pVM)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
fileSize(FILE * f)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
ficlFileSize(FICL_VM * pVM)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
ficlIncludeFile(FICL_VM * pVM)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
ficlReadFile(FICL_VM * pVM)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
ficlReadLine(FICL_VM * pVM)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
ficlWriteFile(FICL_VM * pVM)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
ficlWriteLine(FICL_VM * pVM)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
ficlRepositionFile(FICL_VM * pVM)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
ficlFlushFile(FICL_VM * pVM)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
ficlResizeFile(FICL_VM * pVM)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
ficlCompileFile(FICL_SYSTEM * pSys)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 }
432