/* Part of SWI-Prolog Author: Jan Wielemaker E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org Copyright (c) 2011-2023, University of Amsterdam VU University Amsterdam CWI, Amsterdam SWI-Prolog Solutions b.v. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #ifdef __WINDOWS__ #include #include #endif #include "pl-incl.h" #include "pl-utf8.h" #include "../pl-fli.h" #include #include #ifdef HAVE_SYS_STAT_H #include #endif #ifdef O_XOS #define statstruct struct _stati64 #else #define statstruct struct stat #define statfunc stat #endif #undef LD #define LD LOCAL_LD /******************************* * OS STUFF * *******************************/ /** int LastModifiedFile(const char *file, double *t) Return the last modification time of file as a POSIX timestamp. Returns (time_t)-1 on failure. Contains a 64-bit value representing the number of 100-nanosecond intervals since January 1, 1601 (UTC). */ int LastModifiedFile(const char *name, double *tp) { #ifdef O_XOS return _xos_get_file_time(name, XOS_TIME_MODIFIED, tp) == 0; #else char tmp[PATH_MAX]; statstruct buf; if ( statfunc(OsPath(name, tmp), &buf) < 0 ) return FALSE; #ifdef HAVE_STRUCT_STAT_ST_MTIM *tp = (double)buf.st_mtim.tv_sec + (double)buf.st_mtim.tv_nsec/1.0e9; #else *tp = (double)buf.st_mtime; #endif return TRUE; #endif } /** static int64_t SizeFile(const char *path) Return the size of the file path in bytes. Returns -1 if the file cannot be accessed. */ static int64_t SizeFile(const char *path) { #if O_XOS uint64_t size; if ( _xos_file_size(path, &size) == 0 ) return (int64_t)size; return -1; #else char tmp[PATH_MAX]; statstruct buf; if ( statfunc(OsPath(path, tmp), &buf) < 0 ) return -1; return buf.st_size; #endif } /** int AccessFile(const char *path, int mode) TRUE if path can be accessed in the specified modes. Mode is a bitwise or created from one or more of the constants ACCESS_EXIST, ACCESS_READ, ACCESS_WRITE and ACCESS_EXECUTE. */ #ifndef F_OK #define F_OK 0 #endif static int access_mode(int mode) { int m = 0; if ( mode == ACCESS_EXIST ) m = F_OK; else { if ( mode & ACCESS_READ ) m |= R_OK; if ( mode & ACCESS_WRITE ) m |= W_OK; #ifdef X_OK if ( mode & ACCESS_EXECUTE ) m |= X_OK; #endif } return m; } int AccessFile(const char *path, int mode) { char tmp[PATH_MAX]; #ifdef HAVE_ACCESS return access(OsPath(path, tmp), access_mode(mode)) == 0 ? TRUE : FALSE; #else #error "No implementation for AccessFile()" #endif } int AccessDirectory(const char *path, int mode) { #if O_XOS char tmp[PATH_MAX]; return _xos_access_dir(OsPath(path, tmp), access_mode(mode)) == 0 ? TRUE : FALSE; #else return AccessFile(path, mode); #endif } int ExistsFile(const char *path) { #ifdef O_XOS return _xos_exists(path, _XOS_FILE) == TRUE; #else char tmp[PATH_MAX]; statstruct buf; if ( statfunc(OsPath(path, tmp), &buf) == -1 || !S_ISREG(buf.st_mode) ) { DEBUG(2, perror(tmp)); return FALSE; } return TRUE; #endif } int ExistsDirectory(const char *path) { #ifdef O_XOS return _xos_exists(path, _XOS_DIR) == TRUE; #else char tmp[PATH_MAX]; char *ospath = OsPath(path, tmp); statstruct buf; if ( statfunc(ospath, &buf) < 0 ) return FALSE; if ( S_ISDIR(buf.st_mode) ) return TRUE; return FALSE; #endif /*O_XOS*/ } static char * ReadLink(const char *f, char *buf) { #ifdef HAVE_READLINK int n; if ( (n=readlink(f, buf, PATH_MAX-1)) > 0 ) { buf[n] = EOS; return buf; } #endif return NULL; } static char * DeRefLink1(const char *f, char *lbuf, size_t buflen) { char buf[PATH_MAX]; char *l; if ( (l=ReadLink(f, buf)) ) { if ( l[0] == '/' ) /* absolute path */ { strcpy(lbuf, buf); return lbuf; } else { char *q; if ( f != (const char*)lbuf ) strcpy(lbuf, f); q = &lbuf[strlen(lbuf)]; while(q>lbuf && q[-1] != '/') q--; strcpy(q, l); return canonicaliseFileName(lbuf, buflen); } } return NULL; } /** char *DeRefLink(const char *link, char *buf) Dereference a symbolic link, returning its final destination. The returned filename is canonical (i.e., references to ./ and ../ are removed). Returns NULL if more than 20 links have been followed. */ char * DeRefLink(const char *link, char *buf) { char tmp[PATH_MAX]; char *f; int n = 20; /* avoid loop! */ while((f=DeRefLink1(link, tmp, sizeof(tmp))) && n-- > 0) link = f; if ( PL_exception(0) ) /* Name too long */ return NULL; if ( n > 0 ) { strcpy(buf, link); return buf; } else { GET_LD atom_t dom = PL_new_atom("dereference"); atom_t typ = PL_new_atom("symlink"); term_t t; int rc; rc = ( (t=PL_new_term_ref()) && PL_unify_chars(t, PL_ATOM|REP_FN, -1, link) && PL_error(NULL, 0, "too many (>20) levels of symbolic links", ERR_PERMISSION, dom, typ, t) ); (void)rc; PL_unregister_atom(dom); PL_unregister_atom(typ); return NULL; } } static int SameFile(const char *f1, const char *f2) { GET_LD if ( truePrologFlag(PLFLAG_FILE_CASE) ) { if ( streq(f1, f2) ) return TRUE; } else { if ( strcasecmp(f1, f2) == 0 ) return TRUE; } #ifdef __unix__ /* doesn't work on most not Unix's */ { statstruct buf1; statstruct buf2; char tmp[PATH_MAX]; if ( statfunc(OsPath(f1, tmp), &buf1) != 0 || statfunc(OsPath(f2, tmp), &buf2) != 0 ) return FALSE; if ( buf1.st_ino == buf2.st_ino && buf1.st_dev == buf2.st_dev ) return TRUE; } #endif #ifdef O_XOS return _xos_same_file(f1, f2) == TRUE; #endif /*O_XOS*/ /* Amazing! There is no simple way to check two files for identity. */ /* stat() and fstat() both return dummy values for inode and device. */ /* this is fine as OS'es not supporting symbolic links don't need this */ return FALSE; } /** int RemoveFile(const char *path) Remove a file from the filesystem. Returns TRUE on success and FALSE otherwise. */ int RemoveFile(const char *path) { char tmp[PATH_MAX]; #ifdef HAVE_REMOVE return remove(OsPath(path, tmp)) == 0 ? TRUE : FALSE; #else return unlink(OsPath(path, tmp)) == 0 ? TRUE : FALSE; #endif } static int RenameFile(const char *old, const char *new) { char oldbuf[PATH_MAX]; char newbuf[PATH_MAX]; char *osold, *osnew; osold = OsPath(old, oldbuf); osnew = OsPath(new, newbuf); #ifdef HAVE_RENAME return rename(osold, osnew) == 0 ? TRUE : FALSE; #else { int rval; unlink(osnew); if ( (rval = link(osold, osnew)) == 0 && (rval = unlink(osold)) != 0) unlink(osnew); if ( rval == 0 ) return TRUE; return FALSE; } #endif /*HAVE_RENAME*/ } static int MarkExecutable(const char *name) { #if ( (defined(HAVE_STAT) && defined(HAVE_CHMOD)) || \ defined(__unix__) ) && !defined(__WINDOWS__) statstruct buf; mode_t um; um = umask(0777); umask(um); if ( statfunc(name, &buf) == -1 ) { GET_LD term_t file = PL_new_term_ref(); PL_put_atom_chars(file, name); return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_stat, ATOM_file, file); } if ( (buf.st_mode & 0111) == (~um & 0111) ) return TRUE; buf.st_mode |= 0111 & ~um; if ( chmod(name, buf.st_mode) == -1 ) { GET_LD term_t file = PL_new_term_ref(); PL_put_atom_chars(file, name); return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_chmod, ATOM_file, file); } #endif /* defined(HAVE_STAT) && defined(HAVE_CHMOD) */ return TRUE; } /******************************** * FIND FILES FROM C * *********************************/ int unifyTime(term_t t, time_t time) { return PL_unify_time(t, time); } static int add_option(term_t options, functor_t f, atom_t val) { GET_LD term_t head; if ( (head=PL_new_term_ref()) && PL_unify_list(options, head, options) && PL_unify_term(head, PL_FUNCTOR, f, PL_ATOM, val) ) { PL_reset_term_refs(head); return TRUE; } return FALSE; } #define CVT_FILENAME (CVT_ATOM|CVT_STRING|CVT_LIST) static int get_file_name(term_t n, char **namep, char *tmp, size_t tmplen, int flags) { GET_LD char *name; int chflags; size_t len; if ( flags & PL_FILE_SEARCH ) { fid_t fid; if ( (fid = PL_open_foreign_frame()) ) { if ( !GD->procedures.absolute_file_name3 ) GD->procedures.absolute_file_name3 = PL_predicate("absolute_file_name", 3, "system"); term_t av = PL_new_term_refs(3); term_t options = PL_copy_term_ref(av+2); int rc = TRUE; int cflags = ((flags&PL_FILE_NOERRORS) ? PL_Q_CATCH_EXCEPTION : PL_Q_PASS_EXCEPTION); PL_put_term(av+0, n); if ( rc && flags & PL_FILE_EXIST ) rc = add_option(options, FUNCTOR_access1, ATOM_exist); if ( rc && flags & PL_FILE_READ ) rc = add_option(options, FUNCTOR_access1, ATOM_read); if ( rc && flags & PL_FILE_WRITE ) rc = add_option(options, FUNCTOR_access1, ATOM_write); if ( rc && flags & PL_FILE_EXECUTE ) rc = add_option(options, FUNCTOR_access1, ATOM_execute); if ( rc ) rc = PL_unify_nil(options); if ( rc ) rc = PL_call_predicate(NULL, cflags, GD->procedures.absolute_file_name3, av); if ( rc ) rc = PL_get_nchars(av+1, &len, namep, CVT_ATOMIC|BUF_STACK|REP_FN); if ( rc && strlen(*namep) != len ) { n = av+1; goto code0; } PL_discard_foreign_frame(fid); return rc; } return FALSE; } chflags = CVT_FILENAME; if ( !(flags&(REP_UTF8|REP_MB)) ) chflags |= REP_FN; if ( !(flags & PL_FILE_NOERRORS) ) chflags |= CVT_EXCEPTION; if ( !PL_get_nchars(n, &len, &name, chflags) ) return FALSE; if ( strlen(name) != len ) { code0: return PL_error(NULL, 0, "file name contains a 0-code", ERR_DOMAIN, ATOM_file_name, n); } if ( len >= PATH_MAX ) return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length); if ( truePrologFlag(PLFLAG_FILEVARS) ) { if ( !(name = expandVars(name, tmp, PATH_MAX)) ) return FALSE; } if ( !(flags & PL_FILE_NOERRORS) ) { atom_t op = 0; if ( (flags&(PL_FILE_READ|PL_FILE_WRITE|PL_FILE_EXECUTE|PL_FILE_EXIST)) && !AccessFile(name, ACCESS_EXIST) ) return PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_file, n); if ( (flags&PL_FILE_READ) && !AccessFile(name, ACCESS_READ) ) op = ATOM_read; if ( !op && (flags&PL_FILE_WRITE) && !AccessFile(name, ACCESS_WRITE) ) op = ATOM_write; if ( !op && (flags&PL_FILE_EXECUTE) && !AccessFile(name, ACCESS_EXECUTE) ) op = ATOM_execute; if ( op ) return PL_error(NULL, 0, NULL, ERR_PERMISSION, op, ATOM_file, n); } if ( flags & PL_FILE_ABSOLUTE ) { if ( !(name = AbsoluteFile(name, tmp, tmplen)) ) return FALSE; } *namep = buffer_string(name, BUF_STACK); return TRUE; } int PL_get_file_name(term_t n, char **namep, int flags) { char buf[PATH_MAX]; char ospath[PATH_MAX]; char *name; int rc; if ( (rc=get_file_name(n, &name, buf, sizeof(buf), flags)) ) { if ( (flags & PL_FILE_OSPATH) ) { if ( !(name = OsPath(name, ospath)) ) return FALSE; name = buffer_string(name, BUF_STACK); } *namep = name; } return rc; } int PL_get_file_nameW(term_t n, wchar_t **namep, int flags) { char buf[PATH_MAX]; char ospath[PATH_MAX]; char *name; int rc; if ( (rc=get_file_name(n, &name, buf, sizeof(buf), flags|REP_UTF8)) ) { Buffer b; const char *s; if ( (flags & PL_FILE_OSPATH) ) { if ( !(name = OsPath(name, ospath)) ) return FALSE; } b = findBuffer(BUF_STACK); for(s = name; *s; ) { int chr; PL_utf8_code_point(&s, NULL, &chr); addWcharBuffer(b, chr); } addWcharBuffer(b, 0); *namep = baseBuffer(b, wchar_t); } return rc; } /******************************* * QUERY FILES * *******************************/ static PRED_IMPL("time_file", 2, time_file, 0) { char *fn; if ( PL_get_file_name(A1, &fn, 0) ) { double time; int sl; if ( (sl=file_name_is_iri(fn)) ) { return ( iri_hook(fn, IRI_TIME, &time) && PL_unify_float(A2, time) ); } if ( LastModifiedFile(fn, &time) ) return PL_unify_float(A2, time); return PL_error(NULL, 0, NULL, ERR_FILE_OPERATION, ATOM_time, ATOM_file, A1); } return FALSE; } static PRED_IMPL("size_file", 2, size_file, 0) { PRED_LD char *n; if ( PL_get_file_name(A1, &n, 0) ) { int64_t size; int sl; if ( (sl=file_name_is_iri(n)) ) { return ( iri_hook(n, IRI_SIZE, &size) && PL_unify_int64(A2, size) ); } if ( (size = SizeFile(n)) < 0 ) return PL_error("size_file", 2, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_size, ATOM_file, A1); return PL_unify_int64(A2, size); } return FALSE; } static PRED_IMPL("access_file", 2, access_file, 0) { PRED_LD char *n; int md; atom_t m; int sl; term_t name = A1; term_t mode = A2; if ( !PL_get_atom(mode, &m) ) return PL_error("access_file", 2, NULL, ERR_TYPE, ATOM_atom, mode); if ( !PL_get_file_name(name, &n, 0) ) return FALSE; if ( m == ATOM_none ) return TRUE; if ( m == ATOM_write || m == ATOM_append ) md = ACCESS_WRITE; else if ( m == ATOM_read ) md = ACCESS_READ; else if ( m == ATOM_execute || m == ATOM_search ) md = ACCESS_EXECUTE; else if ( m == ATOM_exist ) md = ACCESS_EXIST; else return PL_error("access_file", 2, NULL, ERR_DOMAIN, ATOM_io_mode, mode); if ( (sl=file_name_is_iri(n)) ) { int rc; if ( !iri_hook(n, IRI_ACCESS, md, &rc) ) return FALSE; return rc; } if ( AccessFile(n, md) ) return TRUE; if ( md == ACCESS_WRITE && !AccessFile(n, ACCESS_EXIST) ) { char tmp[PATH_MAX]; char *dir; if ( !(dir = DirName(n, tmp)) ) return PL_representation_error("max_path_length"); if ( dir[0] ) { if ( !ExistsDirectory(dir) ) return FALSE; } if ( AccessDirectory(dir[0] ? dir : ".", md) ) return TRUE; } return FALSE; } static PRED_IMPL("read_link", 3, read_link, 0) { char *n, *l, *t; char buf[PATH_MAX]; term_t file = A1; term_t link = A2; term_t to = A3; if ( !PL_get_file_name(file, &n, 0) ) return FALSE; if ( (l = ReadLink(n, buf)) && PL_unify_chars(link, PL_ATOM|REP_FN, (size_t)-1, l) && (t = DeRefLink(n, buf)) && PL_unify_chars(to, PL_ATOM|REP_FN, (size_t)-1, t) ) return TRUE; return FALSE; } static PRED_IMPL("exists_file", 1, exists_file, 0) { char *n; int sl; if ( !PL_get_file_name(A1, &n, 0) ) return FALSE; if ( (sl=file_name_is_iri(n)) ) { int rc; if ( !iri_hook(n, IRI_ACCESS, ACCESS_FILE, &rc) ) return FALSE; return rc; } return ExistsFile(n); } static PRED_IMPL("exists_directory", 1, exists_directory, 0) { char *n; int sl; if ( !PL_get_file_name(A1, &n, 0) ) return FALSE; if ( (sl=file_name_is_iri(n)) ) { int rc; if ( !iri_hook(n, IRI_ACCESS, ACCESS_DIRECTORY, &rc) ) return FALSE; return rc; } return ExistsDirectory(n); } static PRED_IMPL("is_absolute_file_name", 1, is_absolute_file_name, 0) { char *n; if ( PL_get_file_name(A1, &n, 0) && (IsAbsolutePath(n) || file_name_is_iri(n)) ) return TRUE; return FALSE; } static PRED_IMPL("same_file", 2, same_file, 0) { char *n1, *n2; if ( PL_get_file_name(A1, &n1, 0) && PL_get_file_name(A2, &n2, 0) ) return SameFile(n1, n2); return FALSE; } static PRED_IMPL("file_base_name", 2, file_base_name, 0) { char *n, *b; char tmp[PATH_MAX]; if ( !PL_get_chars(A1, &n, CVT_ALL|REP_FN|CVT_EXCEPTION) ) return FALSE; if ( (b=BaseName(n, tmp)) ) return PL_unify_chars(A2, PL_ATOM|REP_FN, -1, b); else return PL_representation_error("max_path_length"); } static PRED_IMPL("file_directory_name", 2, file_directory_name, 0) { char *n, *d; char tmp[PATH_MAX]; if ( !PL_get_chars(A1, &n, CVT_ALL|REP_FN|CVT_EXCEPTION) ) return FALSE; if ( (d=DirName(n, tmp)) ) return PL_unify_chars(A2, PL_ATOM|REP_FN, -1, d); else return PL_representation_error("max_path_length"); } /******************************* * TEMPORARY FILES * *******************************/ static PRED_IMPL("tmp_file", 2, tmp_file, 0) { PRED_LD char *n; atom_t fn; term_t base = A1; term_t name = A2; if ( !PL_get_chars(base, &n, CVT_ALL|CVT_EXCEPTION) ) return FALSE; if ( (fn=TemporaryFile(n, "", NULL)) ) return PL_unify_atom(name, fn); else return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_create, ATOM_temporary_file, A1); } /** tmp_file_stream(+Ext, +Encoding, -File, -Stream) */ static PRED_IMPL("$tmp_file_stream", 4, tmp_file_stream, 0) { PRED_LD atom_t fn; int fd; IOENC enc; atom_t encoding; const char *mode; char *ext; if ( !PL_get_chars(A1, &ext, CVT_ATOM|CVT_STRING|CVT_EXCEPTION) || !PL_get_atom_ex(A2, &encoding) ) return FALSE; if ( (enc = PL_atom_to_encoding(encoding)) == ENC_UNKNOWN ) { if ( encoding == ATOM_binary ) { enc = ENC_OCTET; mode = "wb"; } else { return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_encoding, A1); } } else { mode = "w"; } if ( (fn=TemporaryFile("", ext, &fd)) ) { IOSTREAM *s; if ( !PL_unify_atom(A3, fn) ) { close(fd); return PL_error(NULL, 0, NULL, ERR_UNINSTANTIATION, 2, A2); } s = Sfdopen(fd, mode); Ssetenc(s, enc, NULL); return PL_unify_stream(A4, s); } else { return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_create, ATOM_temporary_file, A2); } } /******************************* * CHANGE FILESYSTEM * *******************************/ static PRED_IMPL("delete_file", 1, delete_file, 0) { PRED_LD char *n; atom_t aname; if ( PL_get_atom(A1, &aname) && DeleteTemporaryFile(aname) ) return TRUE; if ( !PL_get_file_name(A1, &n, 0) ) return FALSE; if ( RemoveFile(n) ) return TRUE; return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_delete, ATOM_file, A1); } static PRED_IMPL("delete_directory", 1, delete_directory, 0) { char *n; if ( !PL_get_file_name(A1, &n, 0) ) return FALSE; if ( rmdir(n) == 0 ) return TRUE; else return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_delete, ATOM_directory, A1); } static PRED_IMPL("make_directory", 1, make_directory, 0) { char *n; if ( !PL_get_file_name(A1, &n, 0) ) return FALSE; if ( mkdir(n, 0777) == 0 ) return TRUE; else return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_create, ATOM_directory, A1); } static PRED_IMPL("rename_file", 2, rename_file, 0) { PRED_LD char *o, *n; term_t old = A1; term_t new = A2; if ( PL_get_file_name(old, &o, 0) && PL_get_file_name(new, &n, 0) ) { if ( SameFile(o, n) ) { if ( truePrologFlag(PLFLAG_FILEERRORS) ) return PL_error("rename_file", 2, "same file", ERR_PERMISSION, ATOM_rename, ATOM_file, old); return FALSE; } if ( RenameFile(o, n) ) return TRUE; if ( truePrologFlag(PLFLAG_FILEERRORS) ) return PL_error("rename_file", 2, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_rename, ATOM_file, old); return FALSE; } return FALSE; } static PRED_IMPL("$absolute_file_name", 2, absolute_file_name, 0) { char *n; char tmp[PATH_MAX]; term_t name = A1; term_t expanded = A2; if ( PL_get_file_name(name, &n, 0) ) { if ( (n = AbsoluteFile(n, tmp, sizeof(tmp))) ) return PL_unify_chars(expanded, PL_ATOM|REP_FN, -1, n); } return FALSE; } static PRED_IMPL("$cwd", 1, cwd, 0) { char buf[PATH_MAX]; const char *wd; if ( !(wd = PL_cwd(buf, sizeof(buf))) ) return FALSE; return PL_unify_chars(A1, PL_ATOM|REP_FN, (size_t)-1, wd); } static PRED_IMPL("$chdir", 1, chdir, 0) { PRED_LD char *n; if ( PL_get_file_name(A1, &n, 0) ) { if ( ChDir(n) ) return TRUE; if ( truePrologFlag(PLFLAG_FILEERRORS) ) return PL_error(NULL, 0, NULL, ERR_FILE_OPERATION, ATOM_chdir, ATOM_directory, A1); } return FALSE; } static int has_extension(const char *name, const char *ext) { GET_LD const char *s = name + strlen(name); if ( ext[0] == EOS ) return TRUE; while(*s != '.' && *s != '/' && s > name) s--; if ( *s == '.' && s > name && s[-1] != '/' ) { if ( ext[0] == '.' ) ext++; if ( truePrologFlag(PLFLAG_FILE_CASE) ) return strcmp(&s[1], ext) == 0; else return strcasecmp(&s[1], ext) == 0; } return FALSE; } static int name_too_long(void) { return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length); } static PRED_IMPL("file_name_extension", 3, file_name_extension, 0) { PRED_LD char *b = NULL, *e = NULL, *f; char buf[PATH_MAX]; term_t base = A1; term_t ext = A2; term_t full = A3; if ( !PL_is_variable(full) ) { if ( PL_get_chars(full, &f, CVT_ALL|CVT_EXCEPTION|REP_FN) ) { char *s = f + strlen(f); /* ?base, ?ext, +full */ while(*s != '.' && *s != '/' && s > f) s--; if ( *s == '.' ) { if ( PL_get_chars(ext, &e, CVT_ALL|REP_FN) ) { if ( e[0] == '.' ) e++; if ( truePrologFlag(PLFLAG_FILE_CASE) ) { TRY(strcmp(&s[1], e) == 0); } else { TRY(strcasecmp(&s[1], e) == 0); } } else { TRY(PL_unify_chars(ext, PL_ATOM|REP_FN, -1, &s[1])); } return PL_unify_chars(base, PL_ATOM|REP_FN, s-f, f); } if ( PL_unify_atom_chars(ext, "") && PL_unify(full, base) ) PL_succeed; } PL_fail; } if ( PL_get_chars(base, &b, CVT_ALL|BUF_STACK|REP_FN|CVT_EXCEPTION) && PL_get_chars(ext, &e, CVT_ALL|REP_FN|CVT_EXCEPTION) ) { char *s; if ( e[0] == '.' ) /* +Base, +Extension, -Full */ e++; if ( has_extension(b, e) || e[0] == EOS ) return PL_unify(base, full); if ( strlen(b) + 1 + strlen(e) + 1 > PATH_MAX ) return name_too_long(); strcpy(buf, b); s = buf + strlen(buf); *s++ = '.'; strcpy(s, e); return PL_unify_chars(full, PL_ATOM|REP_FN, -1, buf); } else return FALSE; } static PRED_IMPL("prolog_to_os_filename", 2, prolog_to_os_filename, 0) { PRED_LD term_t pl = A1; term_t os = A2; #ifdef O_XOS wchar_t *wn; if ( !PL_is_variable(pl) ) { char *n; char buf[PATH_MAX]; if ( PL_get_chars(pl, &n, CVT_ALL|REP_UTF8|CVT_EXCEPTION) ) { if ( !_xos_os_filename(n, buf, PATH_MAX) ) return name_too_long(); return PL_unify_chars(os, PL_ATOM|REP_UTF8, -1, buf); } return FALSE; } if ( PL_get_wchars(os, NULL, &wn, CVT_ALL) ) { wchar_t lbuf[PATH_MAX]; char buf[PATH_MAX]; _xos_long_file_nameW(wn, lbuf, PATH_MAX); _xos_canonical_filenameW(lbuf, buf, PATH_MAX, 0); return PL_unify_chars(pl, PL_ATOM|REP_UTF8, -1, buf); } return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, pl); #else /*O_XOS*/ return PL_unify(pl, os); #endif /*O_XOS*/ } static PRED_IMPL("$mark_executable", 1, mark_executable, 0) { char *name; if ( !PL_get_file_name(A1, &name, 0) ) return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_source_sink, A1); return MarkExecutable(name); } /** * '$my_file'(+Path) is semidet. * * True if Path exists and is owned by the same user as the current * process. If the OS or filesystem doesn't support ownership the * result is true if Path exists. */ static PRED_IMPL("$my_file", 1, my_file, 0) { char *n; if ( !PL_get_file_name(A1, &n, 0) || file_name_is_iri(n) ) return FALSE; #ifdef HAVE_GETUID { statstruct buf; char tmp[PATH_MAX]; if ( statfunc(OsPath(n, tmp), &buf) < 0 ) { perror(tmp); return FALSE; } if ( buf.st_uid != getuid() ) return FALSE; } #endif return TRUE; } /******************************* * PUBLISH PREDICATES * *******************************/ BeginPredDefs(files) PRED_DEF("$cwd", 1, cwd, 0) PRED_DEF("$chdir", 1, chdir, 0) PRED_DEF("access_file", 2, access_file, 0) PRED_DEF("time_file", 2, time_file, 0) PRED_DEF("size_file", 2, size_file, 0) PRED_DEF("read_link", 3, read_link, 0) PRED_DEF("exists_file", 1, exists_file, 0) PRED_DEF("exists_directory", 1, exists_directory, 0) PRED_DEF("tmp_file", 2, tmp_file, 0) PRED_DEF("$tmp_file_stream", 4, tmp_file_stream, 0) PRED_DEF("delete_file", 1, delete_file, 0) PRED_DEF("delete_directory", 1, delete_directory, 0) PRED_DEF("make_directory", 1, make_directory, 0) PRED_DEF("same_file", 2, same_file, 0) PRED_DEF("rename_file", 2, rename_file, 0) PRED_DEF("is_absolute_file_name", 1, is_absolute_file_name, 0) PRED_DEF("file_base_name", 2, file_base_name, 0) PRED_DEF("file_directory_name", 2, file_directory_name, 0) PRED_DEF("file_name_extension", 3, file_name_extension, 0) PRED_DEF("prolog_to_os_filename", 2, prolog_to_os_filename, 0) PRED_DEF("$mark_executable", 1, mark_executable, 0) PRED_DEF("$absolute_file_name", 2, absolute_file_name, 0) PRED_DEF("$my_file", 1, my_file, 0) EndPredDefs