library(system).
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@36 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
cb3b0a6714
commit
cc692eb415
346
library/system.yap
Normal file
346
library/system.yap
Normal file
@ -0,0 +1,346 @@
|
||||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: system.yap *
|
||||
* Last rev: *
|
||||
* mods: *
|
||||
* comments: Operating System Access built-ins *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
:- module(system, [
|
||||
chmod/2,
|
||||
datime/1,
|
||||
delete_file/1,
|
||||
delete_file/2,
|
||||
directory_files/2,
|
||||
environ/2,
|
||||
exec/3,
|
||||
file_exists/1,
|
||||
file_exists/2,
|
||||
file_property/2,
|
||||
fmode/2,
|
||||
host_id/1,
|
||||
host_name/1,
|
||||
pid/1,
|
||||
kill/2,
|
||||
mktemp/2,
|
||||
make_directory/1,
|
||||
popen/3,
|
||||
rename_file/2,
|
||||
shell/1,
|
||||
shell/2,
|
||||
sleep/1,
|
||||
system/1,
|
||||
system/2,
|
||||
time/1,
|
||||
tmpnam/1,
|
||||
wait/2,
|
||||
working_directory/2
|
||||
]).
|
||||
|
||||
:- load_foreign_files([sys], [], init_sys).
|
||||
|
||||
% time builtins
|
||||
|
||||
datime(X) :-
|
||||
datime(X, Error),
|
||||
handle_system_error(Error, off, datime(X)).
|
||||
|
||||
% file operations
|
||||
|
||||
delete_file(File) :-
|
||||
delete_file(File, off, on, off).
|
||||
|
||||
delete_file(File, Opts) :-
|
||||
process_delete_file_opts(Opts, Dir, Recurse, Ignore, delete_file(File,Opts)),
|
||||
delete_file(File, Dir, Recurse, Ignore).
|
||||
|
||||
process_delete_file_opts(V, _, _, _, T) :- var(V), !,
|
||||
throw(error(instantiation_error,T)).
|
||||
process_delete_file_opts([], off, off, off, _) :- !.
|
||||
process_delete_file_opts([V|_], _, _, _, T) :- var(V), !,
|
||||
throw(error(instantiation_error,T)).
|
||||
process_delete_file_opts([directory|Opts], on, Recurse, Ignore, T) :- !,
|
||||
process_delete_file_opts(Opts, _, Recurse, Ignore, T).
|
||||
process_delete_file_opts([recursive|Opts], Dir, on, Ignore, T) :- !,
|
||||
process_delete_file_opts(Opts, Dir, _, Ignore, T).
|
||||
process_delete_file_opts([ignore|Opts], Dir, Recurse, on, T) :- !,
|
||||
process_delete_file_opts(Opts, Dir, Recurse, _, T).
|
||||
process_delete_file_opts(Opts, _, _, _, T) :-
|
||||
throw(error(domain_error(delete_file_option,Opts),T)).
|
||||
|
||||
delete_file(File, Dir, Recurse, Ignore) :-
|
||||
file_property(File, Type, _, _, _Permissions, Ignore),
|
||||
delete_file(Type, File, Dir, Recurse, Ignore).
|
||||
|
||||
delete_file(N, File, Dir, Recurse, Ignore) :- number(N), !, % error.
|
||||
handle_system_error(N, Ignore, delete_file(File)).
|
||||
delete_file(directory, File, Dir, Recurse, Ignore) :-
|
||||
delete_directory(Dir, File, Recurse, Ignore).
|
||||
delete_file(_, File, Dir, Recurse, Ignore) :-
|
||||
unlink_file(File, Ignore).
|
||||
|
||||
unlink_file(File, Ignore) :-
|
||||
unlink(File, N),
|
||||
handle_system_error(N, Ignore, delete_file(File)).
|
||||
|
||||
delete_directory(on, File, Recurse, Ignore) :-
|
||||
rm_directory(File, Ignore).
|
||||
delete_directory(off, File, Recurse, Ignore) :-
|
||||
delete_directory(Recurse, File, Ignore).
|
||||
|
||||
rm_directory(File, Ignore) :-
|
||||
rmdir(File, Error),
|
||||
handle_system_error(Error, Ignore, delete_file(File)).
|
||||
|
||||
delete_directory(on, File, Ignore) :-
|
||||
directory_files(File, FileList, Ignore),
|
||||
dir_separator(D),
|
||||
atom_concat(File, D, FileP),
|
||||
delete_dirfiles(FileList, FileP, Ignore),
|
||||
rmdir(File, Ignore).
|
||||
|
||||
delete_dirfiles([], _, _).
|
||||
delete_dirfiles(['.'|Fs], File, Ignore) :- !.
|
||||
delete_dirfiles(['..'|Fs], File, Ignore) :- !.
|
||||
delete_dirfiles([F|Fs], File, Ignore) :-
|
||||
atom_concat(File,F,TrueF),
|
||||
delete_file(TrueF, off, on, Ignore),
|
||||
delete_dirfiles(Fs, File, Ignore).
|
||||
|
||||
directory_files(File, FileList) :-
|
||||
directory_files(File, FileList, off).
|
||||
|
||||
directory_files(File, FileList, Ignore) :-
|
||||
list_directory(File, FileList, Error),
|
||||
handle_system_error(Error, Ignore, directory_files(File, FileList)).
|
||||
|
||||
handle_system_error(Error, Ignore, G) :- var(Error), !.
|
||||
handle_system_error(Error, off, G) :-
|
||||
error_message(Error, Message),
|
||||
throw(error(system_error(Message),G)).
|
||||
|
||||
file_property(File, type(Type)) :-
|
||||
file_property(File, Type, _Size, _Date).
|
||||
file_property(File, size(Size)) :-
|
||||
file_property(File, _Type, Size, _Date).
|
||||
file_property(File, mod_time(Date)) :-
|
||||
file_property(File, _Type, _Size, Date).
|
||||
|
||||
file_property(File, Type, Size, Date) :-
|
||||
file_property(File, Type, Size, Date, Permissions, Error),
|
||||
handle_system_error(Error, off, file_property(File)).
|
||||
|
||||
file_exists(File) :-
|
||||
file_property(File, _Type, _Size, _Date, _Permissions, Error),
|
||||
var(Error).
|
||||
|
||||
file_exists(File, Permissions) :-
|
||||
file_property(File, _Type, _Size, _Date, FPermissions, Error),
|
||||
var(Error),
|
||||
process_permissions(Permissions, Perms),
|
||||
FPermissions /\ Perms =:= Perms.
|
||||
|
||||
process_permissions(Number, Number) :- integer(Number).
|
||||
|
||||
make_directory(Dir) :-
|
||||
var(Dir), !,
|
||||
throw(error(instantiation_error,mkdir(Dir))).
|
||||
make_directory(Dir) :-
|
||||
atom(Dir), !,
|
||||
mkdir(Dir,Err),
|
||||
handle_system_error(Error, off, mkdir(Dir)).
|
||||
make_directory(Dir) :-
|
||||
throw(error(type_error(atom,X),make_directory(Dir))).
|
||||
|
||||
rename_file(Old, New) :-
|
||||
atom(Old), atom(New), !,
|
||||
rename_file(Old, New, Error),
|
||||
handle_system_error(Error, off, rename_file(Old, New)).
|
||||
rename_file(X,Y) :- (var(X) ; var(Y)), !,
|
||||
throw(error(instantiation_error,rename_file(X,Y))).
|
||||
rename_file(X,Y) :- atom(X), !,
|
||||
throw(error(type_error(atom,Y),rename_file(X,Y))).
|
||||
rename_file(X,Y) :-
|
||||
throw(error(type_error(atom,X),rename_file(X,Y))).
|
||||
|
||||
%
|
||||
% environment manipulation.
|
||||
%
|
||||
|
||||
environ(Na,Val) :- var(Na), !,
|
||||
environ_enum(0,I),
|
||||
( p_environ(I,S) -> environ_split(S,SNa,SVal) ; !, fail ),
|
||||
atom_codes(Na, SNa),
|
||||
atom_codes(Val, SVal).
|
||||
environ(Na,Val) :- atom(Na), !,
|
||||
bound_environ(Na, Val).
|
||||
environ(Na,Val) :-
|
||||
throw(type_error(atom,Na),environ(Na,Val)).
|
||||
|
||||
bound_environ(Na, Val) :- var(Val), !,
|
||||
getenv(Na,Val).
|
||||
bound_environ(Na, Val) :- atom(Val), !,
|
||||
putenv(Na,Val).
|
||||
bound_environ(Na, Val) :-
|
||||
throw(type_error(atom,Val),environ(Na,Val)).
|
||||
|
||||
environ_enum(X,X).
|
||||
environ_enum(X,X1) :-
|
||||
Xi is X+1,
|
||||
environ_enum(Xi,X1).
|
||||
|
||||
environ_split([61|SVal], [], SVal) :- !.
|
||||
environ_split([C|S],[C|SNa],SVal) :-
|
||||
environ_split(S,SNa,SVal).
|
||||
|
||||
working_directory(OLD, NEW) :-
|
||||
getcwd(OLD),
|
||||
cd(NEW).
|
||||
|
||||
%
|
||||
% process execution
|
||||
%
|
||||
exec(Command, [StdIn, StdOut, StdErr], PID) :-
|
||||
G = exec(Command, [StdIn, StdOut, StdErr], PID),
|
||||
check_command(Command, G),
|
||||
process_inp_stream_for_exec(StdIn, In, G),
|
||||
process_out_stream_for_exec(StdOut, Out, G),
|
||||
process_err_stream_for_exec(StdErr, Err, G),
|
||||
( exec_command(Command, In, Out, Err, PID, Error) -> true ; true ),
|
||||
close_temp_streams(StdIn, In, StdOut, Out, StdErr, Err),
|
||||
handle_system_error(Error, off, G).
|
||||
|
||||
process_inp_stream_for_exec(Error, _, G) :- var(Error), !,
|
||||
throw(error(instantiation_error,G)).
|
||||
process_inp_stream_for_exec(null, 0, _) :- !.
|
||||
process_inp_stream_for_exec(std, '$stream'(0), _) :- !.
|
||||
process_inp_stream_for_exec(pipe(SOut), SInp, _) :- !,
|
||||
open_pipe_streams(SInp, SOut).
|
||||
process_inp_stream_for_exec(Stream, Stream, _) :-
|
||||
stream_property(Stream, input).
|
||||
|
||||
|
||||
process_out_stream_for_exec(Error, _, G) :- var(Error), !,
|
||||
throw(error(instantiation_error,G)).
|
||||
process_out_stream_for_exec(null, 0, _) :- !.
|
||||
process_out_stream_for_exec(std, '$stream'(1), _) :- !.
|
||||
process_out_stream_for_exec(pipe(SInp), SOut, _) :- !,
|
||||
open_pipe_streams(SInp, SOut).
|
||||
process_out_stream_for_exec(Stream, Stream, _) :-
|
||||
stream_property(Stream, output).
|
||||
|
||||
process_err_stream_for_exec(Error, _, G) :- var(Error), !,
|
||||
throw(error(instantiation_error,G)).
|
||||
process_err_stream_for_exec(null, 0, _) :- !.
|
||||
process_err_stream_for_exec(std, '$stream'(2), _) :- !.
|
||||
process_err_stream_for_exec(pipe(SInp), SOut, _) :- !,
|
||||
open_pipe_streams(SInp, SOut).
|
||||
process_err_stream_for_exec(Stream, Stream, _) :-
|
||||
stream_property(Stream, output).
|
||||
|
||||
close_temp_streams(pipe(_), S, _, _, _, _) :- close(S), fail.
|
||||
close_temp_streams(_, _, pipe(_), S, _, _) :- close(S), fail.
|
||||
close_temp_streams(_, _, _, _, pipe(_), S) :- close(S), fail.
|
||||
close_temp_streams(_, _, _, _, _, _).
|
||||
|
||||
|
||||
popen(Command, Mode, Stream) :-
|
||||
G = popen(Command, Mode, Stream),
|
||||
check_command(Command, G),
|
||||
check_mode(Mode, M, G),
|
||||
popen(Command, M, Stream, Result),
|
||||
handle_system_error(Error, off, G).
|
||||
|
||||
check_command(Com, G) :- var(Com), !,
|
||||
throw(error(instantiation_error,G)).
|
||||
check_command(Com, G) :- atom(Com), !.
|
||||
check_command(Com, G) :-
|
||||
throw(type_error(atom,Com),G).
|
||||
|
||||
check_mode(Mode, _, G) :- var(G), !,
|
||||
throw(error(instantiation_error,G)).
|
||||
check_mode(read, 0, _) :- !.
|
||||
check_mode(write,1, _) :- !.
|
||||
check_mode(Mode, G) :-
|
||||
throw(domain_error(io_mode,Mode),G).
|
||||
|
||||
shell(Command, Status) :-
|
||||
G = shell(Command, Status),
|
||||
check_command(Command, G),
|
||||
do_shell(Status, Error),
|
||||
( var(Error) -> Status = 0 ; Status = Error).
|
||||
|
||||
system(Command, Status) :-
|
||||
G = system(Command, Status),
|
||||
check_command(Command, G),
|
||||
do_system(Status, Status).
|
||||
|
||||
sleep(Interval) :- var(Interval), !,
|
||||
throw(error(instantiation_error,sleep(Interval))).
|
||||
sleep(Interval) :- number(Interval), !,
|
||||
( Interval =< 0 ->
|
||||
throw(error(domain_error(not_less_than_zero,Interval),
|
||||
sleep(Interval)))
|
||||
;
|
||||
sleep(Interval, _Remainder)
|
||||
).
|
||||
sleep(Interval) :-
|
||||
throw(error(type_error(number,Interval),sleep(Interval))).
|
||||
|
||||
wait(PID,STATUS) :- var(PID), !,
|
||||
throw(error(instantiation_error,wait(PID,STATUS))).
|
||||
wait(PID,STATUS) :- integer(PID), !,
|
||||
wait(PID, STATUS, Error),
|
||||
handle_system_error(Error, off, wait(PID,STATUS)).
|
||||
wait(PID,STATUS) :-
|
||||
throw(error(type_error(integer,PID),wait(PID,STATUS))).
|
||||
|
||||
%
|
||||
% host info
|
||||
%
|
||||
host_name(X) :-
|
||||
host_name(X, Error),
|
||||
handle_system_error(Error, off, host_name(X)).
|
||||
|
||||
host_id(X) :-
|
||||
host_id(X0, Error),
|
||||
handle_system_error(Error, off, host_id(X)),
|
||||
number_codes(X0, S),
|
||||
atom_codes(X, S).
|
||||
|
||||
pid(X) :-
|
||||
pid(X, Error),
|
||||
handle_system_error(Error, off, pid(X)).
|
||||
|
||||
kill(X,Y) :-
|
||||
integer(X), integer(Y), !,
|
||||
kill(X, Y, Error),
|
||||
handle_system_error(Error, off, kill(X,Y)).
|
||||
kill(X,Y) :- (var(X) ; var(Y)), !,
|
||||
throw(error(instantiation_error,kill(X,Y))).
|
||||
kill(X,Y) :- integer(X), !,
|
||||
throw(error(type_error(integer,Y),kill(X,Y))).
|
||||
kill(X,Y) :-
|
||||
throw(error(type_error(integer,X),kill(X,Y))).
|
||||
|
||||
mktemp(X,Y) :- var(X), !,
|
||||
throw(error(instantiation_error,mktemp(X,Y))).
|
||||
mktemp(X,Y) :-
|
||||
atom(X), !,
|
||||
mktemp(X, Y, Error),
|
||||
handle_system_error(Error, off, mktemp(X,Y)).
|
||||
mktemp(X,Y) :-
|
||||
throw(error(type_error(atom,X),mktemp(X,Y))).
|
||||
|
||||
tmpnam(X) :-
|
||||
tmpnam(X, Error),
|
||||
handle_system_error(Error, off, tmpnam(X)).
|
||||
88
library/system/Makefile.in
Normal file
88
library/system/Makefile.in
Normal file
@ -0,0 +1,88 @@
|
||||
#
|
||||
# default base directory for YAP installation
|
||||
#
|
||||
ROOTDIR = @prefix@
|
||||
#
|
||||
# where the binary should be
|
||||
#
|
||||
BINDIR = $(ROOTDIR)/bin
|
||||
#
|
||||
# where YAP should look for libraries
|
||||
#
|
||||
LIBDIR=$(ROOTDIR)/lib/Yap
|
||||
#
|
||||
#
|
||||
CC=@CC@
|
||||
CFLAGS= @CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include
|
||||
#
|
||||
#
|
||||
# You shouldn't need to change what follows.
|
||||
#
|
||||
INSTALL=@INSTALL@
|
||||
INSTALL_DATA=@INSTALL_DATA@
|
||||
INSTALL_PROGRAM=@INSTALL_PROGRAM@
|
||||
SHELL=/bin/sh
|
||||
RANLIB=@RANLIB@
|
||||
srcdir=@srcdir@
|
||||
SHLIB_CFLAGS=@SHLIB_CFLAGS@
|
||||
SHLIB_SUFFIX=@SHLIB_SUFFIX@
|
||||
#4.1VPATH=@srcdir@:@srcdir@/OPTYap
|
||||
CWD=$(PWD)
|
||||
#
|
||||
|
||||
OBJS=sys.o
|
||||
SOBJS=sys@SHLIB_SUFFIX@
|
||||
|
||||
#in some systems we just create a single object, in others we need to
|
||||
# create a libray
|
||||
|
||||
all: @NEWSHOBJ@
|
||||
|
||||
sobjs: $(SOBJS)
|
||||
|
||||
dll: sys@SHLIB_SUFFIX@
|
||||
|
||||
sys.o: $(srcdir)/sys.c
|
||||
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/sys.c -o sys.o
|
||||
|
||||
%.so: %.o
|
||||
@SHLIB_LD@ -o $@ $<
|
||||
|
||||
sys.so: sys.o
|
||||
@SHLIB_LD@ -o sys.so sys.o
|
||||
|
||||
#
|
||||
# create a new DLL library on cygwin environments
|
||||
#
|
||||
# DLLNAME: name of the new dll
|
||||
# OBJS: list of object files I want to put in
|
||||
# LIBS: list of libraries to link with
|
||||
# DEFFILE is the name of the definitions file.
|
||||
# BASEFILE temporary
|
||||
# EXPFILE temporary
|
||||
# ENTRY is the entry point int WINAPI startup (HINSTANCE, DWORD, LPVOID)
|
||||
#
|
||||
DLLTOOL=dlltool
|
||||
DLLNAME=sys.dll
|
||||
DLL_LIBS=-lcrtdll -L../.. -lWYap
|
||||
BASE_FILE=sys.base
|
||||
EXP_FILE=sys.exp
|
||||
DEF_FILE=$(srcdir)/sys.def
|
||||
ENTRY_FUNCTION=_win_sys@12
|
||||
#
|
||||
sys.dll: $(OBJS)
|
||||
$(LD) -s --base-file $(BASE_FILE) --dll -o $(DLLNAME) $(OBJS) $(DLL_LIBS) -e $(ENTRY_FUNCTION)
|
||||
$(DLLTOOL) --as=$(AS) --dllname $(DLLNAME) --def $(DEF_FILE) --base-file $(BASE_FILE) --output-exp $(EXP_FILE)
|
||||
$(LD) -s --base-file $(BASE_FILE) $(EXP_FILE) -dll -o $(DLLNAME) $(OBJS) $(DLL_LIBS) -e $(ENTRY_FUNCTION)
|
||||
$(DLLTOOL) --as=$(AS) --dllname $(DLLNAME) --def $(DEF_FILE) --base-file $(BASE_FILE) --output-exp $(EXP_FILE)
|
||||
$(LD) $(EXP_FILE) --dll -o $(DLLNAME) $(OBJS) $(DLL_LIBS) -e $(ENTRY_FUNCTION)
|
||||
|
||||
install: all
|
||||
$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(LIBDIR)
|
||||
|
||||
install_mingw32: dll
|
||||
$(INSTALL_PROGRAM) -m 755 sys.dll $(LIBDIR)/sys.dll
|
||||
|
||||
clean:
|
||||
rm -f *.o *.so *~ $(OBJS) *.BAK
|
||||
|
||||
581
library/system/sys.c
Normal file
581
library/system/sys.c
Normal file
@ -0,0 +1,581 @@
|
||||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: regexp.c *
|
||||
* Last rev: *
|
||||
* mods: *
|
||||
* comments: regular expression interpreter *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
#include "config.h"
|
||||
#include "c_interface.h"
|
||||
#if STDC_HEADERS
|
||||
#include <stdlib.h>
|
||||
#endif
|
||||
#if HAVE_UNISTD_H
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
#include <stdio.h>
|
||||
#if HAVE_TIME_H
|
||||
#include <time.h>
|
||||
#endif
|
||||
#if HAVE_SYS_TYPES_H
|
||||
#include <sys/types.h>
|
||||
#endif
|
||||
#if HAVE_SYS_STAT_H
|
||||
#include <sys/stat.h>
|
||||
#endif
|
||||
#if HAVE_FCNTL_H
|
||||
#include <fcntl.h>
|
||||
#endif
|
||||
#if HAVE_UNISTD_H
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
#if HAVE_ERRNO_H
|
||||
#include <errno.h>
|
||||
#endif
|
||||
#if HAVE_STRING_H
|
||||
#include <string.h>
|
||||
#endif
|
||||
#if HAVE_SIGNAL_H
|
||||
#include <signal.h>
|
||||
#endif
|
||||
#if HAVE_SYS_WAIT_H
|
||||
#include <sys/wait.h>
|
||||
#endif
|
||||
#if HAVE_DIRENT_H
|
||||
#include <dirent.h>
|
||||
#endif
|
||||
|
||||
#ifdef __MINGW32__
|
||||
#ifdef HAVE_ENVIRON
|
||||
#undef HAVE_ENVIRON
|
||||
#endif
|
||||
#endif
|
||||
|
||||
void PROTO(init_sys, (void));
|
||||
|
||||
/* Return time in a structure */
|
||||
static int
|
||||
datime(void)
|
||||
{
|
||||
Term tf, out[6];
|
||||
#ifdef HAVE_TIME
|
||||
time_t tp;
|
||||
|
||||
if ((tp = time(NULL)) == -1) {
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
}
|
||||
#ifdef HAVE_LOCALTIME
|
||||
{
|
||||
struct tm *loc = localtime(&tp);
|
||||
if (loc == NULL) {
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
}
|
||||
out[0] = MkIntTerm(loc->tm_year);
|
||||
out[1] = MkIntTerm(loc->tm_mon);
|
||||
out[2] = MkIntTerm(loc->tm_mday);
|
||||
out[3] = MkIntTerm(loc->tm_hour);
|
||||
out[4] = MkIntTerm(loc->tm_min);
|
||||
out[5] = MkIntTerm(loc->tm_sec);
|
||||
}
|
||||
#else
|
||||
oops
|
||||
#endif /* HAVE_LOCALTIME */
|
||||
#else
|
||||
oops
|
||||
#endif /* HAVE_TIME */
|
||||
tf = MkApplTerm(MkFunctor(LookupAtom("datime"),6), 6, out);
|
||||
return(unify(ARG1, tf));
|
||||
}
|
||||
|
||||
#define BUF_SIZE 1024
|
||||
|
||||
/* Return a list of files for a directory */
|
||||
static int
|
||||
list_directory(void)
|
||||
{
|
||||
Term tf = MkAtomTerm(LookupAtom("[]"));
|
||||
|
||||
char *buf = AtomName(AtomOfTerm(ARG1));
|
||||
#if HAVE_OPENDIR
|
||||
{
|
||||
DIR *de;
|
||||
struct dirent *dp;
|
||||
|
||||
if ((de = opendir(buf)) == NULL) {
|
||||
return(unify(ARG3, MkIntTerm(errno)));
|
||||
}
|
||||
while ((dp = readdir(de))) {
|
||||
Term ti = MkAtomTerm(LookupAtom(dp->d_name));
|
||||
tf = MkPairTerm(ti, tf);
|
||||
}
|
||||
closedir(de);
|
||||
}
|
||||
#endif /* HAVE_OPENDIR */
|
||||
return(unify(ARG2, tf));
|
||||
}
|
||||
|
||||
static int
|
||||
p_unlink(void)
|
||||
{
|
||||
char *fd = AtomName(AtomOfTerm(ARG1));
|
||||
if (unlink(fd) == -1) {
|
||||
/* return an error number */
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
}
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static int
|
||||
p_mkdir(void)
|
||||
{
|
||||
char *fd = AtomName(AtomOfTerm(ARG1));
|
||||
if (mkdir(fd, 0777) == -1) {
|
||||
/* return an error number */
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
}
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static int
|
||||
p_rmdir(void)
|
||||
{
|
||||
char *fd = AtomName(AtomOfTerm(ARG1));
|
||||
if (rmdir(fd) == -1) {
|
||||
/* return an error number */
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
}
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static int
|
||||
rename_file(void)
|
||||
{
|
||||
char *s1 = AtomName(AtomOfTerm(ARG1));
|
||||
char *s2 = AtomName(AtomOfTerm(ARG2));
|
||||
#if HAVE_RENAME
|
||||
if (rename(s1, s2) == -1) {
|
||||
/* return an error number */
|
||||
return(unify(ARG3, MkIntTerm(errno)));
|
||||
}
|
||||
#endif
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static int
|
||||
dir_separator(void)
|
||||
{
|
||||
return(unify(ARG1,MkAtomTerm(LookupAtom("/"))));
|
||||
}
|
||||
|
||||
static int
|
||||
file_property(void)
|
||||
{
|
||||
char *fd;
|
||||
#if HAVE_LSTAT
|
||||
struct stat buf;
|
||||
|
||||
fd = AtomName(AtomOfTerm(ARG1));
|
||||
if (lstat(fd, &buf) == -1) {
|
||||
/* return an error number */
|
||||
return(unify(ARG6, MkIntTerm(errno)));
|
||||
}
|
||||
if (S_ISREG(buf.st_mode))
|
||||
unify(ARG2, MkAtomTerm(LookupAtom("regular")));
|
||||
else if (S_ISDIR(buf.st_mode))
|
||||
unify(ARG2, MkAtomTerm(LookupAtom("directory")));
|
||||
else if (S_ISFIFO(buf.st_mode))
|
||||
unify(ARG2, MkAtomTerm(LookupAtom("fifo")));
|
||||
else if (S_ISLNK(buf.st_mode))
|
||||
unify(ARG2, MkAtomTerm(LookupAtom("symlink")));
|
||||
else if (S_ISSOCK(buf.st_mode))
|
||||
unify(ARG2, MkAtomTerm(LookupAtom("socket")));
|
||||
else
|
||||
unify(ARG2, MkAtomTerm(LookupAtom("unknown")));
|
||||
unify(ARG3, MkIntTerm(buf.st_size));
|
||||
unify(ARG4, MkIntTerm(buf.st_mtime));
|
||||
unify(ARG5, MkIntTerm(buf.st_mode));
|
||||
#endif
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
/* temporary files */
|
||||
|
||||
static int
|
||||
p_mktemp(void)
|
||||
{
|
||||
#if HAVE_MKTEMP
|
||||
char *s, tmp[1024];
|
||||
s = AtomName(AtomOfTerm(ARG1));
|
||||
#if HAVE_STRNCPY
|
||||
strncpy(tmp, s, 1024);
|
||||
#else
|
||||
strcpy(tmp, s);
|
||||
#endif
|
||||
if ((s = mktemp(tmp)) == NULL) {
|
||||
/* return an error number */
|
||||
return(unify(ARG3, MkIntTerm(errno)));
|
||||
}
|
||||
return(unify(ARG2,MkAtomTerm(LookupAtom(s))));
|
||||
#else
|
||||
oops
|
||||
#endif
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static int
|
||||
p_tpmnam(void)
|
||||
{
|
||||
#if HAVE_TMPNAM
|
||||
return(unify(ARG1,MkAtomTerm(LookupAtom(tmpnam(NULL)))));
|
||||
#else
|
||||
oops
|
||||
#endif
|
||||
}
|
||||
|
||||
/* return YAP's environment */
|
||||
static int
|
||||
p_environ(void)
|
||||
{
|
||||
#if HAVE_ENVIRON
|
||||
extern char **environ;
|
||||
Term t1 = ARG1;
|
||||
Int i;
|
||||
|
||||
i = IntOfTerm(t1);
|
||||
if (environ[i] == NULL)
|
||||
return(FALSE);
|
||||
else {
|
||||
Term t = BufferToString(environ[i]);
|
||||
return(unify(t, ARG2));
|
||||
}
|
||||
#else
|
||||
YapError("environ not available in this configuration");
|
||||
return(FALSE);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* execute a command as a detached process */
|
||||
static int
|
||||
execute_command(void)
|
||||
{
|
||||
Term ti = ARG2, to = ARG3, te = ARG4;
|
||||
Term tzero = MkIntTerm(0);
|
||||
int res;
|
||||
int inpf, outf, errf;
|
||||
/* process input first */
|
||||
if (ti == tzero) {
|
||||
inpf = open("/dev/null", O_RDONLY);
|
||||
} else {
|
||||
int sd = YapStreamToFileNo(ti);
|
||||
inpf = dup(sd);
|
||||
}
|
||||
if (inpf < 0) {
|
||||
/* return an error number */
|
||||
return(unify(ARG6, MkIntTerm(errno)));
|
||||
}
|
||||
/* then output stream */
|
||||
if (to == tzero) {
|
||||
outf = open("/dev/zero", O_WRONLY);
|
||||
} else {
|
||||
int sd = YapStreamToFileNo(to);
|
||||
outf = dup(sd);
|
||||
}
|
||||
if (outf < 0) {
|
||||
/* return an error number */
|
||||
return(unify(ARG6, MkIntTerm(errno)));
|
||||
}
|
||||
/* then error stream */
|
||||
if (te == tzero) {
|
||||
errf = open("/dev/zero", O_WRONLY);
|
||||
} else {
|
||||
int sd = YapStreamToFileNo(te);
|
||||
errf = dup(sd);
|
||||
}
|
||||
if (errf < 0) {
|
||||
/* return an error number */
|
||||
return(unify(ARG6, MkIntTerm(errno)));
|
||||
}
|
||||
/* we are now ready to fork */
|
||||
if ((res = fork()) < 0) {
|
||||
/* close streams we don't need */
|
||||
close(inpf);
|
||||
close(outf);
|
||||
close(errf);
|
||||
/* return an error number */
|
||||
return(unify(ARG6, MkIntTerm(errno)));
|
||||
} else if (res == 0) {
|
||||
char *argv[4];
|
||||
|
||||
/* child */
|
||||
/* close current streams, but not std streams */
|
||||
YapCloseAllOpenStreams();
|
||||
close(0);
|
||||
dup(inpf);
|
||||
close(1);
|
||||
dup(outf);
|
||||
close(2);
|
||||
dup(outf);
|
||||
close(inpf);
|
||||
close(outf);
|
||||
close(errf);
|
||||
argv[0] = "sh";
|
||||
argv[1] = "-c";
|
||||
argv[2] = AtomName(AtomOfTerm(ARG1));
|
||||
argv[3] = NULL;
|
||||
execv("/bin/sh", argv);
|
||||
exit(127);
|
||||
/* we have the streams where we want them, just want to execute now */
|
||||
} else {
|
||||
close(inpf);
|
||||
close(outf);
|
||||
close(errf);
|
||||
return(unify(ARG5,MkIntTerm(res)));
|
||||
}
|
||||
}
|
||||
|
||||
/* execute a command as a detached process */
|
||||
static int
|
||||
shell(void)
|
||||
{
|
||||
char *command = AtomName(AtomOfTerm(ARG1));
|
||||
int pid;
|
||||
/* we are now ready to fork */
|
||||
if ((pid = fork()) < 0) {
|
||||
/* return an error number */
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
} else if (pid == 0) {
|
||||
char *argv[4];
|
||||
char *shell;
|
||||
|
||||
/* child */
|
||||
/* close current streams, but not std streams */
|
||||
YapCloseAllOpenStreams();
|
||||
#if HAVE_GETENV
|
||||
shell = getenv ("SHELL");
|
||||
if (shell == NULL)
|
||||
shell = "/bin/sh";
|
||||
#endif
|
||||
argv[0] = shell;
|
||||
argv[1] = "-c";
|
||||
argv[2] = command;
|
||||
argv[3] = NULL;
|
||||
execv("/bin/sh", argv);
|
||||
exit(127);
|
||||
/* we have the streams where we want them, just want to execute now */
|
||||
} else {
|
||||
do {
|
||||
int status;
|
||||
|
||||
/* check for interruptions */
|
||||
if (waitpid(pid, &status, 0) == -1) {
|
||||
if (errno != EINTR)
|
||||
return -1;
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
} else
|
||||
return(TRUE);
|
||||
} while(TRUE);
|
||||
}
|
||||
}
|
||||
|
||||
/* execute a command as a detached process */
|
||||
static int
|
||||
p_system(void)
|
||||
{
|
||||
char *command = AtomName(AtomOfTerm(ARG1));
|
||||
int sys = system(command);
|
||||
#if HAVE_SYSTEM
|
||||
return(unify(ARG2, MkIntTerm(sys)));
|
||||
#endif
|
||||
}
|
||||
|
||||
/* execute a command as a detached process */
|
||||
static int
|
||||
p_wait(void)
|
||||
{
|
||||
Int pid = IntOfTerm(ARG1);
|
||||
do {
|
||||
int status;
|
||||
|
||||
/* check for interruptions */
|
||||
if (waitpid(pid, &status, 0) == -1) {
|
||||
if (errno != EINTR)
|
||||
return -1;
|
||||
return(unify(ARG3, MkIntTerm(errno)));
|
||||
} else {
|
||||
return(unify(ARG2, MkIntTerm(status)));
|
||||
}
|
||||
} while(TRUE);
|
||||
}
|
||||
|
||||
/* execute a command as a detached process */
|
||||
static int
|
||||
p_popen(void)
|
||||
{
|
||||
char *command = AtomName(AtomOfTerm(ARG1));
|
||||
Int mode = IntOfTerm(ARG2);
|
||||
FILE *pfd;
|
||||
Term tsno;
|
||||
int flags;
|
||||
|
||||
#if HAVE_POPEN
|
||||
if (mode == 0)
|
||||
pfd = popen(command, "r");
|
||||
else
|
||||
pfd = popen(command, "w");
|
||||
if (pfd == NULL) {
|
||||
return(unify(ARG4, MkIntTerm(errno)));
|
||||
}
|
||||
if (mode == 0)
|
||||
flags = YAP_INPUT_STREAM | YAP_POPEN_STREAM;
|
||||
else
|
||||
flags = YAP_OUTPUT_STREAM | YAP_POPEN_STREAM;
|
||||
tsno = YapOpenStream((void *)pfd,
|
||||
"pipe",
|
||||
MkAtomTerm(LookupAtom("pipe")),
|
||||
flags);
|
||||
#endif
|
||||
return(unify(ARG3, tsno));
|
||||
}
|
||||
|
||||
static int
|
||||
p_sleep(void)
|
||||
{
|
||||
Term ts = ARG1;
|
||||
Int secs = 0, usecs = 0, out;
|
||||
if (IsIntTerm(ts)) {
|
||||
secs = IntOfTerm(ts);
|
||||
} else if (IsFloatTerm(ts)) {
|
||||
flt tfl = FloatOfTerm(ts);
|
||||
if (tfl > 1.0)
|
||||
secs = tfl;
|
||||
else
|
||||
usecs = tfl*1000;
|
||||
}
|
||||
#if HAVE_USLEEP
|
||||
if (usecs > 0) {
|
||||
usleep(usecs);
|
||||
out = 0;
|
||||
} else
|
||||
#endif
|
||||
#if HAVE_SLEEP
|
||||
{
|
||||
out = sleep(secs);
|
||||
}
|
||||
#endif
|
||||
return(unify(ARG2, MkIntTerm(out)));
|
||||
}
|
||||
|
||||
/* host info */
|
||||
|
||||
static int
|
||||
host_name(void)
|
||||
{
|
||||
char name[256];
|
||||
#if HAVE_GETHOSTNAME
|
||||
if (gethostname(name, 256) == -1) {
|
||||
/* return an error number */
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
}
|
||||
#endif
|
||||
return(unify(ARG1, MkAtomTerm(LookupAtom(name))));
|
||||
}
|
||||
|
||||
static int
|
||||
host_id(void)
|
||||
{
|
||||
#if HAVE_GETHOSTID
|
||||
return(unify(ARG1, MkIntTerm(gethostid())));
|
||||
#endif
|
||||
}
|
||||
|
||||
static int
|
||||
pid(void)
|
||||
{
|
||||
return(unify(ARG1, MkIntTerm(getpid())));
|
||||
}
|
||||
|
||||
static int
|
||||
p_kill(void)
|
||||
{
|
||||
#if HAVE_KILL
|
||||
if (kill(IntOfTerm(ARG1), IntOfTerm(ARG2)) < 0) {
|
||||
/* return an error number */
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
}
|
||||
#else
|
||||
oops
|
||||
#endif
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static int
|
||||
error_message(void)
|
||||
{
|
||||
#if HAVE_STRERROR
|
||||
return(unify(ARG2,MkAtomTerm(LookupAtom(strerror(IntOfTerm(ARG1))))));
|
||||
#else
|
||||
#if HAVE_STRERROR
|
||||
return(unify(ARG2,ARG1));
|
||||
#endif
|
||||
#endif
|
||||
}
|
||||
|
||||
void
|
||||
init_sys(void)
|
||||
{
|
||||
UserCPredicate("datime", datime, 2);
|
||||
UserCPredicate("list_directory", list_directory, 3);
|
||||
UserCPredicate("file_property", file_property, 6);
|
||||
UserCPredicate("unlink", p_unlink, 2);
|
||||
UserCPredicate("mkdir", p_mkdir, 2);
|
||||
UserCPredicate("rmdir", p_rmdir, 2);
|
||||
UserCPredicate("dir_separator", dir_separator, 1);
|
||||
UserCPredicate("p_environ", p_environ, 2);
|
||||
UserCPredicate("exec_command", execute_command, 6);
|
||||
UserCPredicate("do_shell", shell, 2);
|
||||
UserCPredicate("do_system", p_system, 2);
|
||||
UserCPredicate("popen", p_popen, 4);
|
||||
UserCPredicate("wait", p_wait, 3);
|
||||
UserCPredicate("host_name", host_name, 2);
|
||||
UserCPredicate("host_id", host_id, 2);
|
||||
UserCPredicate("pid", pid, 2);
|
||||
UserCPredicate("kill", p_kill, 3);
|
||||
UserCPredicate("mktemp", p_mktemp, 3);
|
||||
UserCPredicate("tmpnam", p_tpmnam, 2);
|
||||
UserCPredicate("rename_file", rename_file, 3);
|
||||
UserCPredicate("sleep", p_sleep, 2);
|
||||
UserCPredicate("error_message", error_message, 2);
|
||||
}
|
||||
|
||||
#ifdef _WIN32
|
||||
|
||||
#include <windows.h>
|
||||
|
||||
int WINAPI PROTO(win_system, (HANDLE, DWORD, LPVOID));
|
||||
|
||||
int WINAPI win_system(HANDLE hinst, DWORD reason, LPVOID reserved)
|
||||
{
|
||||
switch (reason)
|
||||
{
|
||||
case DLL_PROCESS_ATTACH:
|
||||
break;
|
||||
case DLL_PROCESS_DETACH:
|
||||
break;
|
||||
case DLL_THREAD_ATTACH:
|
||||
break;
|
||||
case DLL_THREAD_DETACH:
|
||||
break;
|
||||
}
|
||||
p return 1;
|
||||
}
|
||||
#endif
|
||||
Reference in New Issue
Block a user