YAP 7.1.0
files.c
1/*************************************************************************
2 * *
3 * YAP Prolog *
4 * *
5 * Yap Prolog was developed at NCCUP - Universidade do Porto *
6 * *
7 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8 * *
9 **************************************************************************
10 * *
11 * File: iopreds.c *
12 * Last rev: 5/2/88 *
13 * mods: *
14 * comments: Input/Output C implemented predicates *
15 * *
16 *************************************************************************/
17#ifdef SCCS
18static char SccsId[] = "%W% %G%";
19#endif
20
21/*
22 * This file includes the definition of a miscellania of standard predicates
23 * for yap refering to: Files and GLOBAL_Streams, Simple Input/Output,
24 *
25 */
33#include "cwalk/cwalk.h"
34#include "sysbits.h"
35#include "yapio.h"
36
37#if HAVE_DIRENT_H
38#include <dirent.h>
39#endif
40#if HAVE_DIRECT_H
41#include <direct.h>
42#endif
43#if HAVE_SYS_TIMEB_H
44#include <sys/timeb.h>
45#endif
46#if defined(__MINGW32__) || _MSC_VER
47#include <io.h>
48#include <windows.h>
49#endif
50
51static Int file_exists(USES_REGS1) {
52 Term tname = Deref(ARG1);
53 char *file_name;
54
55 if (IsVarTerm(tname)) {
56 Yap_ThrowError(INSTANTIATION_ERROR, tname, "access");
57 } else if (!IsAtomTerm(tname)) {
58 Yap_ThrowError(TYPE_ERROR_ATOM, tname, "access");
59 return false;
60 } else {
61#if HAVE_STAT
62 struct SYSTEM_STAT ss;
63
64 file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
65 if (SYSTEM_STAT(file_name, &ss) != 0) {
66 if (errno == ENOENT)
67 return false;
68 UnixIOError(errno, CREATE_DIRECTORY, tname, "error %s", strerror(errno));
69 return false;
70 }
71 return true;
72#else
73 return FALSE;
74#endif
75 }
76}
77
78static Int time_file(USES_REGS1) {
79 Term tname = Deref(ARG1);
80
81 if (IsVarTerm(tname)) {
82 Yap_Error(INSTANTIATION_ERROR, tname, "access");
83 return FALSE;
84 } else if (!IsAtomTerm(tname)) {
85 Yap_Error(TYPE_ERROR_ATOM, tname, "access");
86 return FALSE;
87 } else {
88 const char *n = RepAtom(AtomOfTerm(tname))->StrOfAE;
89 VFS_t *vfs;
90 if ((vfs = vfs_owner(n))) {
91 vfs_stat s;
92 vfs->stat(vfs, n, &s);
93 return Yap_unify(ARG2, MkIntegerTerm(s.st_mtimespec.tv_sec));
94 }
95#if __WIN32
96 FILETIME ft;
97 HANDLE hdl;
98 Term rc;
99
100 if ((hdl = CreateFile(n, 0, 0, NULL, OPEN_EXISTING, 0, 0)) == 0) {
101 Yap_WinError("in time_file");
102 return false;
103 }
104 if (GetFileTime(hdl, NULL, NULL, &ft) == 0) {
105 Yap_WinError("in time_file");
106 return false;
107 }
108 // Convert the last-write time to local time.
109 // FileTimeToSystemTime(&ftWrite, &stUTC);
110 // SystemTimeToTzSpecificLocalTime(NULL, &stUTC, &stLocal);
111 CloseHandle(hdl);
112 ULONGLONG qwResult;
113
114 // Copy the time into a quadword.
115 qwResult = (((ULONGLONG)ft.dwHighDateTime) << 32) + ft.dwLowDateTime;
116#if SIZEOF_INT_P == 8
117 rc = MkIntegerTerm(qwResult);
118#elif USE_GMP
119 char s[64];
120 MP_INT rop;
121
122 snprintf(s, 64, "%I64d", (long long int)n);
123 mpz_init_set_str(&rop, s, 10);
124 rc = Yap_MkBigIntTerm((void *)&rop PASS_REGS);
125#else
126 rc = MkIntegerTerm(ft.dwHighDateTime);
127#endif
128 return Yap_unify(ARG2, rc);
129#elif HAVE_STAT
130 struct SYSTEM_STAT ss;
131
132 if (SYSTEM_STAT(n, &ss) != 0) {
133 /* ignore errors while checking a file */
134 return FALSE;
135 }
136 return Yap_unify(ARG2, MkIntegerTerm(ss.st_mtime));
137#else
138 return FALSE;
139#endif
140 }
141}
142
149static Int get_time(USES_REGS1) {
150#if __WIN32
151 FILETIME ft;
152 Term rc;
153
154 if (GetSystenTimeAsFileTime(&ft) == 0) {
155 Yap_WinError("in time_file");
156 return false;
157 }
158 ULONGLONG qwResult;
159
160 // Copy the time into a quadword.
161 qwResult = (((ULONGLONG)ft.dwHighDateTime) << 32) + ft.dwLowDateTime;
162#if SIZEOF_INT_P == 8
163 rc = MkIntegerTerm(qwResult);
164#elif USE_GMP
165 char s[64];
166 MP_INT rop;
167
168 snprintf(s, 64, "%I64d", (long long int)n);
169 mpz_init_set_str(&rop, s, 10);
170 rc = Yap_MkBigIntTerm((void *)&rop PASS_REGS);
171#else
172 rc = MkIntegerTerm(ft.dwHighDateTime);
173#endif
174 return Yap_unify(ARG1, rc);
175#elif HAVE_GETTIMEOFDAY
176 struct timeval tv;
177 if (gettimeofday(&tv, NULL) != 0) {
178 /* ignore errors while checking a file */
179 return false;
180 }
181 return Yap_unify(MkIntegerTerm(tv.tv_sec*1000000+tv.tv_usec),ARG1);
182#elif HAVE_FTIME
183 struct timeb ss;
184
185 if (ftime(&ss) != 0) {
186 /* ignore errors while checking a file */
187 return false;
188 }
189 return Yap_unify(ARG1, MkIntegerTerm(ss.time));
190#else
191 return FALSE;
192#endif
193}
194
195static Int file_size(USES_REGS1) {
196 int rc;
197 Int sno = Yap_CheckStream(
198 ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f),
199 "file_size/2");
200 if (sno < 0)
201 return (FALSE);
202 VFS_t *vfs;
203 char *s = RepAtom(GLOBAL_Stream[sno].name)->StrOfAE;
204 if (!s)
205 return false;
206 if ((vfs = vfs_owner(s))) {
207 vfs_stat st;
208 vfs->stat(vfs, s, &st);
209 UNLOCK(GLOBAL_Stream[sno].streamlock);
210 return Yap_unify_constant(ARG2, MkIntegerTerm(st.st_size));
211 }
212 if (GLOBAL_Stream[sno].status & Seekable_Stream_f &&
213 !(GLOBAL_Stream[sno].status &
214 (InMemory_Stream_f | Socket_Stream_f | Pipe_Stream_f))) {
215 // there
216 struct stat file_stat;
217 if ((rc = fstat(fileno(GLOBAL_Stream[sno].file), &file_stat)) < 0) {
218 UNLOCK(GLOBAL_Stream[sno].streamlock);
219 if (rc == ENOENT)
220 PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG1, "%s in file_size",
221 strerror(errno));
222 else
223 PlIOError(PERMISSION_ERROR_INPUT_STREAM, ARG1, "%s in file_size",
224 strerror(errno));
225 return false;
226 }
227 // and back again
228 UNLOCK(GLOBAL_Stream[sno].streamlock);
229 return Yap_unify_constant(ARG2, MkIntegerTerm(file_stat.st_size));
230 }
231 UNLOCK(GLOBAL_Stream[sno].streamlock);
232 return false;
233}
234
235static Int lines_in_file(USES_REGS1) {
236 Int sno = Yap_CheckStream(ARG1, (Input_Stream_f), "lines_in_file/2");
237 if (sno < 0)
238 return false;
239 FILE *f = GLOBAL_Stream[sno].file;
240 size_t count = 0;
241 int ch;
242#if __ANDROID__
243#define getw getc
244#endif
245 if (!f)
246 return false;
247 while ((ch = getw(f)) >= 0) {
248 if (ch == '\n') {
249 count++;
250 }
251 }
252 return Yap_unify(ARG2, MkIntegerTerm(count));
253}
254
255static Int access_file(USES_REGS1) {
256 Term tname = Deref(ARG1);
257 Term tmode = Deref(ARG2);
258 char *ares;
259 Atom atmode;
260
261 if (IsVarTerm(tmode)) {
262 Yap_Error(INSTANTIATION_ERROR, tmode, "access_file/2");
263 return FALSE;
264 } else if (!IsAtomTerm(tmode)) {
265 Yap_Error(TYPE_ERROR_ATOM, tname, "access_file/2");
266 return FALSE;
267 }
268 atmode = AtomOfTerm(tmode);
269 if (IsVarTerm(tname)) {
270 Yap_Error(INSTANTIATION_ERROR, tname, "access_file/2");
271 return FALSE;
272 } else if (!IsAtomTerm(tname)) {
273 Yap_Error(TYPE_ERROR_ATOM, tname, "access_file/2");
274 return FALSE;
275 } else {
276 if (atmode == AtomNone)
277 return TRUE;
278 if (!(ares = RepAtom(AtomOfTerm(tname))->StrOfAE))
279 return FALSE;
280 }
281 VFS_t *vfs;
282 if ((vfs = vfs_owner(ares))) {
283 vfs_stat o;
284 if (vfs->stat(vfs, ares, &o)) {
285 if (atmode == AtomExist)
286 return true;
287 else if (atmode == AtomExists)
288 return true;
289 else if (atmode == AtomWrite)
290 return o.st_mode & VFS_CAN_WRITE;
291 else if (atmode == AtomRead)
292 return o.st_mode & VFS_CAN_READ;
293 else if (atmode == AtomAppend)
294 return o.st_mode & VFS_CAN_WRITE;
295 else if (atmode == AtomCsult)
296 return o.st_mode & VFS_CAN_READ;
297 else if (atmode == AtomExecute)
298 return o.st_mode & VFS_CAN_EXEC;
299 else {
300 Yap_Error(DOMAIN_ERROR_IO_MODE, tmode, "access_file/2");
301 return FALSE;
302 }
303 } else {
304 return false;
305 }
306 }
307#if HAVE_ACCESS
308#if _WIN32
309 {
310 int mode;
311
312 if (atmode == AtomExist)
313 mode = 00;
314 else if (atmode == AtomExists)
315 mode = 00;
316 else if (atmode == AtomWrite)
317 mode = 02;
318 else if (atmode == AtomRead)
319 mode = 04;
320 else if (atmode == AtomAppend)
321 mode = 03;
322 else if (atmode == AtomCsult)
323 mode = 04;
324 else if (atmode == AtomExecute)
325 mode = 00; // can always execute?
326 else {
327 Yap_Error(DOMAIN_ERROR_IO_MODE, tmode, "access_file/2");
328 return FALSE;
329 }
330 if (access(ares, mode) < 0) {
331 /* ignore errors while checking a file */
332 return false;
333 }
334 return true;
335 }
336#else
337 {
338 int mode;
339
340 if (atmode == AtomExist)
341 mode = F_OK;
342 else if (atmode == AtomExists)
343 mode = F_OK;
344 else if (atmode == AtomWrite)
345 mode = W_OK;
346 else if (atmode == AtomRead)
347 mode = R_OK;
348 else if (atmode == AtomAppend)
349 mode = W_OK;
350 else if (atmode == AtomCsult)
351 mode = R_OK;
352 else if (atmode == AtomExecute)
353 mode = X_OK;
354 else {
355 Yap_Error(DOMAIN_ERROR_IO_MODE, tmode, "access_file/2");
356 return FALSE;
357 }
358 if (access(ares, mode) < 0) {
359 /* ignore errors while checking a file */
360 return false;
361 }
362 return true;
363 }
364#endif
365#elif HAVE_STAT
366 {
367 struct SYSTEM_STAT ss;
368
369 if (SYSTEM_STAT(ares, &ss) != 0) {
370 /* ignore errors while checking a file */
371 return FALSE;
372 }
373 return TRUE;
374 }
375#else
376 return FALSE;
377#endif
378}
379
380static Int exists_directory(USES_REGS1) {
381 const char *s =
382 Yap_AbsoluteFile(Yap_TextTermToText(Deref(ARG1) PASS_REGS), true);
383
384 VFS_t *vfs;
385 if (!s)
386 return false;
387 if ((vfs = vfs_owner(s))) {
388 bool rc = true;
389 return vfs->isdir(vfs, s);
390
391 UNLOCK(GLOBAL_Stream[sno].streamlock);
392 return rc;
393 }
394#if HAVE_STAT
395 struct SYSTEM_STAT ss;
396
397 if (SYSTEM_STAT(s, &ss) != 0) {
398 /* ignore errors while checking a file */
399 return false;
400 }
401 return (S_ISDIR(ss.st_mode));
402#else
403 return FALSE;
404#endif
405}
406
407static Int is_absolute_file_name(USES_REGS1) { /* file_base_name(Stream,N) */
408 Term t = Deref(ARG1);
409 Atom at;
410 bool rc;
411 if (IsVarTerm(t)) {
412 Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2");
413 return false;
414 }
415 int l = push_text_stack();
416 const char *buf = Yap_TextTermToText(t PASS_REGS);
417 if (buf) {
418 rc = Yap_IsAbsolutePath(buf, true);
419 } else {
420 at = AtomOfTerm(t);
421#if _WIN32
422 rc = PathIsRelative(RepAtom(at)->StrOfAE);
423#else
424 rc = RepAtom(at)->StrOfAE[0] == '/';
425#endif
426 }
427 pop_text_stack(l);
428 return rc;
429}
430
431static Int file_base_name(USES_REGS1) { /* file_base_name(Stream,N) */
432 Term t = Deref(ARG1);
433 Atom at;
434 if (IsVarTerm(t)) {
435 Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2");
436 return FALSE;
437 }
438 at = AtomOfTerm(t);
439 const char *c = RepAtom(at)->StrOfAE;
440 const char *s;
441#if HAVE_BASENAME && 0 // DISABLED: Linux basename is not compatible with
442 // file_base_name in SWI and GNU
443 char c1[MAX_PATH + 1];
444 strncpy(c1, c, MAX_PATH);
445 s = basename(c1);
446#else
447 Int i = strlen(c);
448 while (i && !Yap_dir_separator((int)c[--i]))
449 ;
450 if (Yap_dir_separator((int)c[i])) {
451 i++;
452 }
453 s = c + i;
454#endif
455 return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
456}
457
458static Int file_directory_name(USES_REGS1) { /* file_directory_name(Stream,N) */
459 Term t = Deref(ARG1);
460 Atom at;
461 if (IsVarTerm(t)) {
462 Yap_Error(INSTANTIATION_ERROR, t, "file_directory_name/2");
463 return false;
464 }
465 at = AtomOfTerm(t);
466 const char *c = RepAtom(at)->StrOfAE;
467#if HAVE_BASENAME && 0 // DISABLED: Linux basename is not compatible with
468 // file_base_name in SWI and GNU
469 const char *s;
470 char c1[MAX_PATH + 1];
471 strncpy(c1, c, MAX_PATH);
472 s = dirname(c1);
473#else
474 char s[MAX_PATH + 1];
475 Int i = strlen(c);
476 strncpy(s, c, MAX_PATH);
477 while (--i) {
478 if (Yap_dir_separator((int)c[i]))
479 break;
480 }
481 if (i == 0) {
482 s[0] = '.';
483 i = 1;
484 }
485 s[i] = '\0';
486#endif
487 return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
488}
489
496static Int make_directory(USES_REGS1) {
497 int lvl = push_text_stack();
498 size_t sz = 0;
499 Term t = Deref(ARG1);
500 const char *fd0;
501
502 if (IsAtomTerm(t))
503 fd0 = RepAtom(AtomOfTerm(t))->StrOfAE;
504 else if (IsStringTerm(t))
505 fd0 = StringOfTerm(t);
506
507 fd0 = Yap_AbsoluteFile(fd0, true PASS_REGS);
508 struct cwk_segment segment;
509 if (!cwk_path_get_first_segment(fd0, &segment)) {
510 printf("Path doesn't have any segments.");
511 return EXIT_FAILURE;
512 }
513 char *s = Malloc(MAX_PATH);
514
515 do {
516 if (segment.size == 0)
517 continue;
518 if (sz == 0) {
519cwk_path_get_root(fd0, &sz);
520 strncpy(s, fd0, sz);
521 s[sz] = '\0';
522 } else {
523 strncpy(s+sz, "/", 2);
524 sz++;
525 }
526 strncpy(s+sz, segment.begin, segment.size);
527 sz += segment.size;
528 s[sz] = '\0';
529 if (!Yap_isDirectory(s)) {
530#if defined(__MINGW32__) || _MSC_VER
531 if (_mkdir(s) == -1) {
532 /* return an CREATE_DIRECTORY,error number */
533 UnixIOError(errno, CREATE_DIRECTORY, ARG1, "mkdir failed to create ",
534 fd, strerror(errno));
535 }
536#else
537 if (mkdir(s, S_IRWXU | S_IRWXG | S_IROTH | S_IXOTH) == -1) {
538 /* return an error number */
539 UnixIOError(errno, CREATE_DIRECTORY, ARG1,
540 "mkdir failed to create %s: %s", s, strerror(errno));
541 }
542#endif
543 }
544 } while (cwk_path_get_next_segment(&segment));
545
546 pop_text_stack(lvl);
547 return true;
548}
549
554static Int list_directory(USES_REGS1) {
555 Term tf = TermNil;
556 VFS_t *vfsp;
557 const char *buf =
558 Yap_AbsoluteFile(Yap_TextTermToText(Deref(ARG1) PASS_REGS), true);
559 if ((vfsp = vfs_owner(buf))) {
560 void *de;
561 const char *dp;
562
563 if ((de = vfsp->opendir(vfsp, buf)) == NULL) {
564 PlIOError(PERMISSION_ERROR_INPUT_STREAM, ARG1, "%s in list_directory",
565 strerror(errno));
566 }
567 while ((dp = vfsp->nextdir(de))) {
568 YAP_Term ti = MkAtomTerm(Yap_LookupAtom(dp));
569 tf = MkPairTerm(ti, tf);
570 }
571 vfsp->closedir(de);
572 } else {
573#if defined(__MINGW32__) || _MSC_VER
574 struct _finddata_t c_file;
575 char bs[BUF_SIZE];
576 long hFile;
577
578 bs[0] = '\0';
579#if HAVE_STRNCPY
580 strncpy(bs, buf, BUF_SIZE);
581#else
582 strcpy(bs, buf);
583#endif
584#if HAVE_STRNCAT
585 strncat(bs, "/*", BUF_SIZE);
586#else
587 strcat(bs, "/*");
588#endif
589 if ((hFile = _findfirst(bs, &c_file)) == -1L) {
590 return (Yap_unify(ARG2, tf));
591 }
592 Yap_PutInSlot(sl, MkPairTerm(MkAtomTerm(Yap_LookupAtom(c_file.name)),
593 Yap_GetFromSlot(sl)));
594 while (_findnext(hFile, &c_file) == 0) {
595 Term ti = MkAtomTerm(Yap_LookupAtom(c_file.name));
596 Yap_PutInSlot(sl, MkPairTerm(ti, Yap_GetFromSlot(sl)));
597 }
598 _findclose(hFile);
599#elif HAVE_OPENDIR
600 {
601 DIR *de;
602 struct dirent *dp;
603
604 if ((de = opendir(buf)) == NULL) {
605 PlIOError(PERMISSION_ERROR_INPUT_STREAM, ARG1, "%s in list_directory",
606 strerror(errno));
607
608 return false;
609 }
610 while ((dp = readdir(de))) {
611 Term ti = MkAtomTerm(Yap_LookupAtom(dp->d_name));
612 tf = MkPairTerm(ti, tf);
613 }
614 closedir(de);
615 }
616#endif /* HAVE_OPENDIR */
617 }
618 return Yap_unify(ARG2, tf);
619}
620
621static Int p_rmdir(USES_REGS1) {
622 const char *fd = Yap_VFAlloc(AtomName(AtomOfTerm(ARG1)));
623#if defined(__MINGW32__) || _MSC_VER
624 if (_rmdir(fd) == -1) {
625#else
626 if (rmdir(fd) == -1) {
627#endif
628 /* return an error number */
629 return (Yap_unify(ARG2, MkIntTerm(errno)));
630 }
631 return true;
632}
633
634static Int access_path(USES_REGS1) {
635 Term tname = Deref(ARG1);
636
637 if (IsVarTerm(tname)) {
638 Yap_Error(INSTANTIATION_ERROR, tname, "access");
639 return false;
640 } else if (!IsAtomTerm(tname)) {
641 Yap_Error(TYPE_ERROR_ATOM, tname, "access");
642 return false;
643 } else {
644 VFS_t *vfs;
645 char *s = RepAtom(AtomOfTerm(tname))->StrOfAE;
646 if (!s)
647 return false;
648 if ((vfs = vfs_owner(s))) {
649 vfs_stat st;
650 bool rc = vfs->stat(vfs, s, &st);
651 UNLOCK(GLOBAL_Stream[sno].streamlock);
652 return rc;
653 }
654#if HAVE_STAT
655 struct SYSTEM_STAT ss;
656 char *file_name;
657
658 file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
659 if (SYSTEM_STAT(file_name, &ss) != 0) {
660 /* ignore errors while checking a file */
661 return true;
662 }
663 return true;
664#else
665 return false;
666#endif
667 }
668}
669
670static Int same_file(USES_REGS1) {
671 char *f1 = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
672 char *f2 = RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE;
673
674 if (strcmp(f1, f2) == 0)
675 return TRUE;
676#if HAVE_LSTAT
677 {
678 int out;
679 struct stat *b1, *b2;
680 while ((char *)HR + sizeof(struct stat) * 2 > (char *)(ASP - 1024)) {
681 if (!Yap_dogc()) {
682 Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
683 return FALSE;
684 }
685 }
686 b1 = (struct stat *)HR;
687 b2 = b1 + 1;
688 if (strcmp(f1, "user_input") == 0) {
689 if (fstat(fileno(GLOBAL_Stream[0].file), b1) == -1) {
690 /* file does not exist, but was opened? Return -1 */
691 return FALSE;
692 }
693 } else if (strcmp(f1, "user_output") == 0) {
694 if (fstat(fileno(GLOBAL_Stream[1].file), b1) == -1) {
695 /* file does not exist, but was opened? Return -1 */
696 return FALSE;
697 }
698 } else if (strcmp(f1, "user_error") == 0) {
699 if (fstat(fileno(GLOBAL_Stream[2].file), b1) == -1) {
700 /* file does not exist, but was opened? Return -1 */
701 return FALSE;
702 }
703 } else if (stat(f1, b1) == -1) {
704 /* file does not exist, but was opened? Return -1 */
705 return FALSE;
706 }
707 if (strcmp(f2, "user_input") == 0) {
708 if (fstat(fileno(GLOBAL_Stream[0].file), b2) == -1) {
709 /* file does not exist, but was opened? Return -1 */
710 return FALSE;
711 }
712 } else if (strcmp(f2, "user_output") == 0) {
713 if (fstat(fileno(GLOBAL_Stream[1].file), b2) == -1) {
714 /* file does not exist, but was opened? Return -1 */
715 return FALSE;
716 }
717 } else if (strcmp(f2, "user_error") == 0) {
718 if (fstat(fileno(GLOBAL_Stream[2].file), b2) == -1) {
719 /* file does not exist, but was opened? Return -1 */
720 return FALSE;
721 }
722 } else if (stat(f2, b2) == -1) {
723 /* file does not exist, but was opened? Return -1 */
724 return FALSE;
725 }
726 out = (b1->st_ino == b2->st_ino
727#ifdef __LCC__
728 && memcmp((const void *)&(b1->st_dev), (const void *)&(b2->st_dev),
729 sizeof(buf1.st_dev)) == 0
730#else
731 && b1->st_dev == b2->st_dev
732#endif
733 );
734 return out;
735 }
736#else
737 return (FALSE);
738#endif
739}
740
741static Int exists_file(USES_REGS1) {
742 Term tname = Deref(ARG1);
743 if (IsVarTerm(tname)) {
744 Yap_Error(TYPE_ERROR_ATOM, tname, "access");
745 return FALSE;
746 } else {
747 VFS_t *vfs;
748 char *s = RepAtom(AtomOfTerm(tname))->StrOfAE;
749 if (!s)
750 return false;
751 if ((vfs = vfs_owner(s))) {
752 vfs_stat st;
753 bool rc = vfs->stat(vfs, s, &st);
754 UNLOCK(GLOBAL_Stream[sno].streamlock);
755 return rc;
756 }
757#if HAVE_STAT
758 struct SYSTEM_STAT ss;
759
760 const char *file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
761 if (SYSTEM_STAT(file_name, &ss) != 0) {
762 /* ignore errors while checking a file */
763 return FALSE;
764 }
765#if _MSC_VER
766 return ss.st_mode & S_IFREG;
767#else
768 return S_ISREG(ss.st_mode);
769#endif
770#else
771 return FALSE;
772#endif
773 }
774}
775
776static Int delete_file(USES_REGS1) {
777 const char *fd =
778 Yap_AbsoluteFile(Yap_TextTermToText(Deref(ARG1) PASS_REGS), true);
779#if defined(__MINGW32__) || _MSC_VER
780 if (_unlink(fd) == -1)
781#else
782 if (unlink(fd) == -1)
783#endif
784 {
785 /* return an error number */
786 Yap_ThrowError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1,
787 "unlink operation failed with error %s", strerror(errno));
788 }
789 return true;
790}
791
792
793 static Int is_regular_file(USES_REGS1) {
794 const char *fd =
795 Yap_AbsoluteFile(Yap_TextTermToText(Deref(ARG1) PASS_REGS), true);
796#if defined(__MINGW32__) || _MSC_VER
797 /* for some weird reason _stat did not work with mingw32 */
798 struct _stat buf;
799 /* return an error number */
800 if (_stat(fd, &buf) != 0) {
801 return PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG1, "%s while verifyng if %s is a regular file", strerror(errno), fd);
802 }
803#else
804 struct stat buf;
805 if (lstat(fd, &buf) == -1) {
806 /* return an error number */
807 return PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG1, "%s while verifyng if %s is a regular file", strerror(errno), fd);
808 }
809 return S_ISREG(buf.st_mode);
810#endif
811 }
812
813void Yap_InitFiles(void) {
814 Yap_InitCPred("file_base_name", 2, file_base_name, SafePredFlag);
815 Yap_InitCPred("file_directory_name", 2, file_directory_name, SafePredFlag);
816 Yap_InitCPred("is_absolute_file_name", 1, is_absolute_file_name,
817 SafePredFlag);
818 Yap_InitCPred("same_file", 2, same_file, SafePredFlag | SyncPredFlag);
819 Yap_InitCPred("$access_file", 2, access_file, SafePredFlag | SyncPredFlag);
820 Yap_InitCPred("$lines_in_file", 2, lines_in_file,
821 SafePredFlag | SyncPredFlag);
822 Yap_InitCPred("access", 1, access_path, SafePredFlag | SyncPredFlag);
823 Yap_InitCPred("exists_directory", 1, exists_directory,
824 SafePredFlag | SyncPredFlag);
825 Yap_InitCPred("exists_file", 1, exists_file, SafePredFlag | SyncPredFlag);
826 Yap_InitCPred("$file_exists", 1, file_exists, SafePredFlag | SyncPredFlag);
827 Yap_InitCPred("time_file64", 2, time_file, SafePredFlag | SyncPredFlag);
828 Yap_InitCPred("time_file", 2, time_file, SafePredFlag | SyncPredFlag);
829 Yap_InitCPred("file_size", 2, file_size, SafePredFlag | SyncPredFlag);
830 Yap_InitCPred("make_directory", 1, make_directory, SyncPredFlag);
831 Yap_InitCPred("list_directory", 2, list_directory, SyncPredFlag);
832 Yap_InitCPred("directory_files", 2, list_directory, SyncPredFlag);
833 Yap_InitCPred("delete_file", 1, delete_file, SyncPredFlag);
834 Yap_InitCPred("$is_regular_file", 1, is_regular_file, SyncPredFlag);
835 Yap_InitCPred("rmdir", 2, p_rmdir, SyncPredFlag);
836 Yap_InitCPred("get_time", 1, get_time, SyncPredFlag);
837}
838
Yap_AbsoluteFile
const char * Yap_AbsoluteFile(const char *spec, bool ok)
generate absolute path, if ok first expand SICStus Prolog style
Definition: absf.c:145
Malloc
void * Malloc(size_t sz USES_REGS)
allocate a temporary text block
Definition: alloc.c:1759
MP_INT
Definition: TermExt.h:345
cwk_segment
A segment represents a single component of a path.
Definition: cwalk.h:15
vfs_stat
Definition: VFS.h:36
vfs
Definition: VFS.h:74
vfs::opendir
void *(* opendir)(struct vfs *, const char *s)
jump around the stream
Definition: VFS.h:96
vfs::stat
bool(* stat)(struct vfs *, const char *s, vfs_stat *)
close access a directory object
Definition: VFS.h:102
vfs::nextdir
const char *(* nextdir)(void *d)
open a directory object, if one exists
Definition: VFS.h:98
vfs::isdir
bool(* isdir)(struct vfs *, const char *s)
obtain size, age, permissions of a file
Definition: VFS.h:104
vfs::closedir
bool(* closedir)(void *d)
walk to the next entry in a directory object
Definition: VFS.h:100