diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
Files
5035f4efe64d31025917e9444e6940b09582c6e9
yap-6.3/os/files.c
Vítor Santos Costa b3cc23ce64 IO patches 
simplify error handling
use get and inject
use wide support in OS
be stricter in checkin streams and arguments
2015-10-08 02:23:45 +01:00

648 lines
16 KiB
C
Raw Blame History

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: iopreds.c *
* Last rev: 5/2/88 *
* mods: *
* comments: Input/Output C implemented predicates *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
/*
* This file includes the definition of a miscellania of standard predicates
* for yap refering to: Files and GLOBAL_Streams, Simple Input/Output,
*
*/
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "yapio.h"
#include "eval.h"
#include "YapText.h"
#include <stdlib.h>
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
#if HAVE_CTYPE_H
#include <ctype.h>
#endif
#if HAVE_WCTYPE_H
#include <wctype.h>
#endif
#if HAVE_LIMITS_H
#include <limits.h>
#endif
#if HAVE_SYS_PARAMS_H
#include <sys/params.h>
#endif
#if HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
#endif
#if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__)
#include <sys/select.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_STRING_H
#include <string.h>
#endif
#if HAVE_LIBGEN_H
#include <libgen.h>
#endif
#if HAVE_SIGNAL_H
#include <signal.h>
#endif
#if HAVE_FCNTL_H
/* for O_BINARY and O_TEXT in WIN32 */
#include <fcntl.h>
#endif
#ifdef _WIN32
#if HAVE_IO_H
/* Windows */
#include <io.h>
#endif
#endif
#if !HAVE_STRNCAT
#define strncat(X,Y,Z) strcat(X,Y)
#endif
#if !HAVE_STRNCPY
#define strncpy(X,Y,Z) strcpy(X,Y)
#endif
#if _MSC_VER || defined(__MINGW32__)
#if HAVE_SOCKET
#include <winsock2.h>
#endif
#include <windows.h>
#ifndef S_ISDIR
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
#endif
#endif
#include "iopreds.h"
#if _MSC_VER || defined(__MINGW32__)
#define SYSTEM_STAT _stat
#else
#define SYSTEM_STAT stat
#endif
static Int
file_name_extension(USES_REGS1)
{
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
Term t3 = Deref(ARG3);
bool use_string = false;
loop:
if (!IsVarTerm((t3))) {
const char *f;
if (IsAtomTerm(t3)) {
f = AtomName( AtomOfTerm( t3 ) );
} else if (IsStringTerm( t3 )) {
f = StringOfTerm( t3 );
use_string = true;
} else if (IsApplTerm(t3) && FunctorOfTerm(t3) == FunctorSlash) {
// descend a compound term of the form a/b.
Term tn1 = MkVarTerm(), tf1;
Term ts[2];
ts[0] = ArgOfTerm(1,t3);
ts[1] = tn1;
tf1 = Yap_MkApplTerm( FunctorSlash, 2, ts );
if (!Yap_unify(ARG1, tf1)) {
return false;
}
t3 = ArgOfTerm(2, t3);
goto loop;
} else {
Yap_Error(TYPE_ERROR_ATOMIC, t3, "file_name_extension/3");
return false;
}
char *pts = strrchr(f, '/');
#if WIN32_ssss
char *pts1 = strrchr(f, '\\');
if (pts11 > pts) pts = pts1;
#endif
char *ss = strrchr(f, '.');
if (pts > ss) ss = NULL;
if (use_string) {
char *tmp;
if (!ss) {
return Yap_unify(ARG1, ARG3) &&
Yap_unify(ARG2, MkStringTerm( "" ) );
}
tmp = malloc((ss - f)+1);
strncpy(tmp, f, (ss)-f);
if (!Yap_unify(ARG1, MkStringTerm( tmp )) ) {
if (tmp != f)
free( tmp );
return false;
}
if (tmp != f)
free(tmp);
// without and with dot
if (!Yap_unify(ARG2, MkStringTerm(ss+1)))
return Yap_unify(ARG2, MkStringTerm(ss));
return true;
} else {
char *tmp;
if (!ss) {
return Yap_unify(ARG1, ARG3) &&
Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom( "" ) ));
}
tmp = malloc((ss - f)+1);
strncpy(tmp, f, (ss)-f);
if (!Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom( tmp ))) ) {
if (tmp != f)
free( tmp );
return false;
}
if (tmp != f)
free(tmp);
// without and with dot
if (!Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(ss+1))))
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(ss)));
return true;
}
} else {
char s[MAXPATHLEN+1];
const char *f1, *f2;
loop1:
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "access");
return FALSE;
} else if (IsAtomTerm(t1)) {
f1 = AtomName( AtomOfTerm( t1 ) );
} else if (IsStringTerm( t1 )) {
f1 = StringOfTerm( t1 );
use_string = true;
} else if (IsApplTerm(t1) && FunctorOfTerm(t1) == FunctorSlash) {
// descend a compound term of the form a/b.
Term tn1 = MkVarTerm(), tf1;
Term ts[2];
ts[0] = ArgOfTerm(1,t1);
ts[1] = tn1;
tf1 = Yap_MkApplTerm( FunctorSlash, 2, ts );
if (!Yap_unify(ARG3, tf1)) {
return false;
}
t1 = ArgOfTerm(2, t1);
goto loop1;
} else {
Yap_Error(TYPE_ERROR_ATOMIC, t1, "file_name_extension/3");
return false;
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, "access");
return FALSE;
} else if (IsAtomTerm(t2)) {
f2 = AtomName( AtomOfTerm( t2 ) );
} else if (IsStringTerm( t1 )) {
f2 = StringOfTerm( t2 );
use_string = true;
} else {
Yap_Error(TYPE_ERROR_ATOMIC, t2, "file_name_extension/3");
return false;
}
if (f2[0] == '.') {
strncpy(s,f1,MAXPATHLEN);
strncat(s,f2,MAXPATHLEN);
if (use_string)
return Yap_unify_constant(ARG3,MkStringTerm(s));
else
return Yap_unify_constant(ARG3,MkAtomTerm(Yap_LookupAtom(s)));
} else {
strncpy(s,f1,MAXPATHLEN);
strncat(s,".",MAXPATHLEN);
strncat(s,f2,MAXPATHLEN);
if (use_string)
return Yap_unify_constant(ARG3,MkStringTerm(s));
else
return Yap_unify_constant(ARG3,MkAtomTerm(Yap_LookupAtom(s)));
}
}
}
static Int
access_path(USES_REGS1)
{
Term tname = Deref(ARG1);
char *file_name;
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "access");
return FALSE;
} else if (!IsAtomTerm (tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "access");
return FALSE;
} else {
#if HAVE_STAT
struct SYSTEM_STAT ss;
file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
if (SYSTEM_STAT(file_name, &ss) != 0) {
/* ignore errors while checking a file */
return FALSE;
}
return TRUE;
#else
return FALSE;
#endif
}
}
static Int
exists_file(USES_REGS1)
{
Term tname = Deref(ARG1);
char *file_name;
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "access");
return FALSE;
} else if (!IsAtomTerm (tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "access");
return FALSE;
} else {
#if HAVE_STAT
struct SYSTEM_STAT ss;
file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
if (SYSTEM_STAT(file_name, &ss) != 0) {
/* ignore errors while checking a file */
return FALSE;
}
return (S_ISREG(ss.st_mode));
#else
return FALSE;
#endif
}
}
static Int
time_file(USES_REGS1)
{
Term tname = Deref(ARG1);
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "access");
return FALSE;
} else if (!IsAtomTerm (tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "access");
return FALSE;
} else {
const char *n = RepAtom(AtomOfTerm(tname))->StrOfAE;
#if __WIN32
FILETIME ftWrite;
if ((hdl = CreateFile( n, 0, 0, NULL, OPEN_EXISTING, NULL)) == 0)
return false;
if (GetFileTime(hdl, NULL,NULL,&ftWrite))
return false;
// Convert the last-write time to local time.
// FileTimeToSystemTime(&ftWrite, &stUTC);
// SystemTimeToTzSpecificLocalTime(NULL, &stUTC, &stLocal);
CloseHandle( hdl );
return Yap_unify(ARG2, MkIntegerTerm(ftWrite));
#elif HAVE_STAT
struct SYSTEM_STAT ss;
if (SYSTEM_STAT(n, &ss) != 0) {
/* ignore errors while checking a file */
return FALSE;
}
return Yap_unify(ARG2, MkIntegerTerm(ss.st_mtime));
#else
return FALSE;
#endif
}
}
static Int
file_size(USES_REGS1)
{
int rc;
Int sno = Yap_CheckStream (ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "file_size/2");
if (sno < 0)
return (FALSE);
if (GLOBAL_Stream[sno]. status & Seekable_Stream_f &&
!(GLOBAL_Stream[sno]. status & (InMemory_Stream_f|Socket_Stream_f|Pipe_Stream_f))) {
// there
struct stat file_stat;
if ((rc = fstat(fileno(GLOBAL_Stream[sno].file), &file_stat) )< 0) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
if (rc == ENOENT)
PlIOError( EXISTENCE_ERROR_SOURCE_SINK, ARG1, "%s in file_size", strerror(errno));
else
PlIOError( PERMISSION_ERROR_INPUT_STREAM, ARG1, "%s in file_size", strerror(errno));
return false;
}
// and back again
UNLOCK(GLOBAL_Stream[sno].streamlock);
return Yap_unify_constant( ARG2, MkIntegerTerm( file_stat.st_size) );
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
return false;
}
/** @pred access_file( + Name, -
*/
static Int
access_file(USES_REGS1)
{
Term tname = Deref(ARG1);
Term tmode = Deref(ARG2);
char ares[YAP_FILENAME_MAX];
Atom atmode;
if (IsVarTerm(tmode)) {
Yap_Error(INSTANTIATION_ERROR, tmode, "access_file/2");
return FALSE;
} else if (!IsAtomTerm (tmode)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "access_file/2");
return FALSE;
}
atmode = AtomOfTerm(tmode);
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "access_file/2");
return FALSE;
} else if (!IsAtomTerm (tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "access_file/2");
return FALSE;
} else {
if (atmode == AtomNone)
return TRUE;
if (!Yap_TrueFileName (RepAtom(AtomOfTerm(tname))->StrOfAE, ares, (atmode == AtomCsult)))
return FALSE;
}
#if HAVE_ACCESS
{
int mode;
if (atmode == AtomExist)
mode = F_OK;
else if (atmode == AtomWrite)
mode = W_OK;
else if (atmode == AtomRead)
mode = R_OK;
else if (atmode == AtomAppend)
mode = W_OK;
else if (atmode == AtomCsult)
mode = R_OK;
else if (atmode == AtomExecute)
mode = X_OK;
else {
PlIOError(DOMAIN_ERROR_IO_MODE, tmode, "access_file/2");
return FALSE;
}
if (access(ares, mode) < 0) {
/* ignore errors while checking a file */
return FALSE;
}
return TRUE;
}
#elif HAVE_STAT
{
struct SYSTEM_STAT ss;
if (SYSTEM_STAT(ares, &ss) != 0) {
/* ignore errors while checking a file */
return FALSE;
}
return TRUE;
}
#else
return FALSE;
#endif
}
static Int
exists_directory(USES_REGS1)
{
Term tname = Deref(ARG1);
char *file_name;
if (IsVarTerm(tname)) {
Yap_Error(INSTANTIATION_ERROR, tname, "exists_directory/1");
return FALSE;
} else if (!IsAtomTerm (tname)) {
Yap_Error(TYPE_ERROR_ATOM, tname, "exists_directory/1");
return FALSE;
} else {
#if HAVE_STAT
struct SYSTEM_STAT ss;
file_name = RepAtom(AtomOfTerm(tname))->StrOfAE;
if (SYSTEM_STAT(file_name, &ss) != 0) {
/* ignore errors while checking a file */
return FALSE;
}
return (S_ISDIR(ss.st_mode));
#else
return FALSE;
#endif
}
}
static Int
is_absolute_file_name ( USES_REGS1 )
{ /* file_base_name(Stream,N) */
Term t = Deref(ARG1);
Atom at;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2");
return FALSE;
}
at = AtomOfTerm(t);
if (IsWideAtom(at)) {
#if _WIN32
return PathisRelativeW(RepAtom(at)->WStrOfAE[0]);
#else
return RepAtom(at)->WStrOfAE[0] == '/';
#endif
} else {
return Yap_IsAbsolutePath( RepAtom(at)->StrOfAE );
}
return false;
}
static Int
file_base_name ( USES_REGS1 )
{ /* file_base_name(Stream,N) */
Term t = Deref(ARG1);
Atom at;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2");
return FALSE;
}
at = AtomOfTerm(t);
if (IsWideAtom(at)) {
wchar_t *c = RepAtom(at)->WStrOfAE;
Int i = wcslen(c);
while (i && !Yap_dir_separator((int)c[--i]));
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupWideAtom(c+i)));
} else {
char *c = RepAtom(at)->StrOfAE;
char *s;
#if HAVE_BASENAME
s = basename( c );
#else
Int i = strlen(c);
while (i && !Yap_dir_separator((int)c[--i]));
if (Yap_dir_separator((int)c[i])) {
i++;
}
s = c+i;
#endif
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
}
}
static Int
file_directory_name ( USES_REGS1 )
{ /* file_directory_name(Stream,N) */
Term t = Deref(ARG1);
Atom at;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "file_directory_name/2");
return FALSE;
}
at = AtomOfTerm(t);
if (IsWideAtom(at)) {
wchar_t s[YAP_FILENAME_MAX+1];
wchar_t *c = RepAtom(at)->WStrOfAE;
Int i = wcslen(c);
while (i && !Yap_dir_separator((int)c[--i]));
if (Yap_dir_separator((int)c[i])) {
i++;
}
wcsncpy(s, c, i);
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupWideAtom(s)));
} else {
char *c = RepAtom(at)->StrOfAE;
#if HAVE_BASENAME
char *s;
s = dirname( c );
#else
char *s[YAP_FILENAME_MAX+1];
Int i = strlen(c);
while (i && !Yap_dir_separator((int)c[--i]));
if (Yap_dir_separator((int)c[i])) {
i++;
}
strncpy(s, c, i);
#endif
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s)));
}
}
static Int
same_file( USES_REGS1 ) {
char *f1 = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
char *f2 = RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE;
if (strcmp(f1,f2) == 0)
return TRUE;
#if HAVE_LSTAT
{
int out;
struct stat *b1, *b2;
while ((char *)HR+sizeof(struct stat)*2 > (char *)(ASP-1024)) {
if (!Yap_gcl(2*sizeof(struct stat), 2, ENV,Yap_gcP() ) ) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return FALSE;
}
}
b1 = (struct stat *)HR;
b2 = b1+1;
if (strcmp(f1,"user_input") == 0) {
if (fstat(fileno(GLOBAL_Stream[0].file), b1) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (strcmp(f1,"user_output") == 0) {
if (fstat(fileno(GLOBAL_Stream[1].file), b1) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (strcmp(f1,"user_error") == 0) {
if (fstat(fileno(GLOBAL_Stream[2].file), b1) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (stat(f1, b1) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
if (strcmp(f2,"user_input") == 0) {
if (fstat(fileno(GLOBAL_Stream[0].file), b2) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (strcmp(f2,"user_output") == 0) {
if (fstat(fileno(GLOBAL_Stream[1].file), b2) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (strcmp(f2,"user_error") == 0) {
if (fstat(fileno(GLOBAL_Stream[2].file), b2) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
} else if (stat(f2, b2) == -1) {
/* file does not exist, but was opened? Return -1 */
return FALSE;
}
out = (b1->st_ino == b2->st_ino
#ifdef __LCC__
&& memcmp((const void *)&(b1->st_dev),(const void *)&(b2->st_dev),sizeof(buf1.st_dev)) == 0
#else
&& b1->st_dev == b2->st_dev
#endif
);
return out;
}
#else
return(FALSE);
#endif
}
void
Yap_InitFiles( void )
{
Yap_InitCPred ("file_base_name", 2, file_base_name, SafePredFlag);
Yap_InitCPred ("file_directory_name", 2, file_directory_name, SafePredFlag);
Yap_InitCPred ("is_absolute_file_name", 1, is_absolute_file_name, SafePredFlag);
Yap_InitCPred ("same_file", 2, same_file, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("access_file", 2, access_file, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("access", 1, access_path, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("exists_directory", 1, exists_directory, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("exists_file", 1, exists_file, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("time_file64", 2, time_file, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("time_file", 2, time_file, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("file_size", 2,file_size, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("file_name_extension", 3, file_name_extension, SafePredFlag|SyncPredFlag);
}
Reference in New Issue View Git Blame Copy Permalink