diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fixes for signal handling

Browse Source 
throw permission error on consulting bad files


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@358 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-02-12 18:24:21 +00:00
parent 39964380f1
commit 777817f8db
9 changed files with 103 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
C/absmi.c
View File

@ -2096,24 +2096,24 @@ absmi(int inp)
} }
else { else {
#endif #endif
#if _MSC_VER || defined(__MINGW32__)
/* I need this for Windows and other systems where SIGINT
is not proceesed by same thread as absmi */
if (PrologMode & (AbortMode|InterruptMode)) { if (PrologMode & (AbortMode|InterruptMode)) {
CFREG = CalculateStackGap(); CFREG = CalculateStackGap();
/* same instruction */ /* same instruction */
if (PrologMode & InterruptMode) { if (PrologMode & InterruptMode) {
PrologMode &= ~InterruptMode; PrologMode &= ~InterruptMode;
ProcessSIGINT();
}
if (PrologMode & AbortMode) {
PrologMode &= ~AbortMode;
ASP = Y+E_CB; ASP = Y+E_CB;
if (ASP > (CELL *)B) if (ASP > (CELL *)B)
ASP = (CELL *)B; ASP = (CELL *)B;
saveregs(); saveregs();
Error(PURE_ABORT, TermNil, ""); ProcessSIGINT();
setregs(); setregs();
} }
JMPNext(); JMPNext();
} }
#endif
#if SHADOW_S #if SHADOW_S
S = SREG; S = SREG;
#endif #endif

25
C/iopreds.c
View File

@ -83,8 +83,6 @@ static char SccsId[] = "%W% %G%";
/* if we botched in a LongIO operation */ /* if we botched in a LongIO operation */
jmp_buf IOBotch; jmp_buf IOBotch;
int in_getc = FALSE;
#if HAVE_LIBREADLINE #if HAVE_LIBREADLINE
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
@ -890,7 +888,6 @@ ReadlineGetc(int sno)
register int ch; register int ch;
while (ttyptr == NULL) { while (ttyptr == NULL) {
in_getc = TRUE;
/* Only sends a newline if we are at the start of a line */ /* Only sends a newline if we are at the start of a line */
if (_line != NULL && _line != (char *) EOF) if (_line != NULL && _line != (char *) EOF)
free (_line); free (_line);
@ -906,16 +903,20 @@ ReadlineGetc(int sno)
while ((ch = *cptr++) != '\0') { while ((ch = *cptr++) != '\0') {
console_count_output_char(ch,Stream+StdErrStream,StdErrStream); console_count_output_char(ch,Stream+StdErrStream,StdErrStream);
} }
PrologMode |= ConsoleGetcMode;
_line = readline (Prompt); _line = readline (Prompt);
} else { } else {
PrologMode |= ConsoleGetcMode;
_line = readline (NULL); _line = readline (NULL);
} }
} else { } else {
if (ReadlinePos != ReadlineBuf) { if (ReadlinePos != ReadlineBuf) {
ReadlinePos[0] = '\0'; ReadlinePos[0] = '\0';
ReadlinePos = ReadlineBuf; ReadlinePos = ReadlineBuf;
PrologMode |= ConsoleGetcMode;
_line = readline (ReadlineBuf); _line = readline (ReadlineBuf);
} else { } else {
PrologMode |= ConsoleGetcMode;
_line = readline (NULL); _line = readline (NULL);
} }
} }
@ -923,16 +924,17 @@ ReadlineGetc(int sno)
if (PrologMode & InterruptMode) { if (PrologMode & InterruptMode) {
PrologMode &= ~InterruptMode; PrologMode &= ~InterruptMode;
ProcessSIGINT(); ProcessSIGINT();
PrologMode &= ~ConsoleGetcMode;
if (PrologMode & AbortMode) { if (PrologMode & AbortMode) {
Error(PURE_ABORT, TermNil, NULL);
ErrorMessage = "Abort"; ErrorMessage = "Abort";
return(console_post_process_read_char(EOF, s, sno)); return(console_post_process_read_char(EOF, s, sno));
} }
continue; continue;
} else {
PrologMode &= ~ConsoleGetcMode;
} }
newline=FALSE; newline=FALSE;
strncpy (Prompt, RepAtom (*AtPrompt)->StrOfAE, MAX_PROMPT); strncpy (Prompt, RepAtom (*AtPrompt)->StrOfAE, MAX_PROMPT);
in_getc = FALSE;
/* window of vulnerability closed */ /* window of vulnerability closed */
if (_line == NULL || _line == (char *) EOF) if (_line == NULL || _line == (char *) EOF)
return(console_post_process_read_char(EOF, s, sno)); return(console_post_process_read_char(EOF, s, sno));
@ -1123,11 +1125,13 @@ ConsoleSocketGetc(int sno)
newline = FALSE; newline = FALSE;
} }
/* should be able to use a buffer */ /* should be able to use a buffer */
PrologMode |= ConsoleGetcMode;
#if _MSC_VER #if _MSC_VER
count = recv(s->u.socket.fd, &c, sizeof(char), 0); count = recv(s->u.socket.fd, &c, sizeof(char), 0);
#else #else
count = read(s->u.socket.fd, &c, sizeof(char)); count = read(s->u.socket.fd, &c, sizeof(char));
#endif #endif
PrologMode &= ~ConsoleGetcMode;
if (count == 0) { if (count == 0) {
ch = EOF; ch = EOF;
} else if (count > 0) { } else if (count > 0) {
@ -1196,12 +1200,16 @@ ConsolePipeGetc(int sno)
} }
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &count, NULL) == FALSE) { if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &count, NULL) == FALSE) {
PrologMode |= ConsoleGetcMode;
PlIOError (SYSTEM_ERROR,TermNil, "read from pipe returned error"); PlIOError (SYSTEM_ERROR,TermNil, "read from pipe returned error");
PrologMode &= ~ConsoleGetcMode;
return(EOF); return(EOF);
} }
#else #else
/* should be able to use a buffer */ /* should be able to use a buffer */
PrologMode |= ConsoleGetcMode;
count = read(s->u.pipe.fd, &c, sizeof(char)); count = read(s->u.pipe.fd, &c, sizeof(char));
PrologMode &= ~ConsoleGetcMode;
#endif #endif
if (count == 0) { if (count == 0) {
ch = EOF; ch = EOF;
@ -1282,22 +1290,23 @@ ConsoleGetc(int sno)
#if HAVE_SIGINTERRUPT #if HAVE_SIGINTERRUPT
siginterrupt(SIGINT, TRUE); siginterrupt(SIGINT, TRUE);
#endif #endif
in_getc = TRUE; PrologMode |= ConsoleGetcMode;
ch = YP_fgetc(s->u.file.file); ch = YP_fgetc(s->u.file.file);
in_getc = FALSE;
#if HAVE_SIGINTERRUPT #if HAVE_SIGINTERRUPT
siginterrupt(SIGINT, FALSE); siginterrupt(SIGINT, FALSE);
#endif #endif
if (PrologMode & InterruptMode) { if (PrologMode & InterruptMode) {
PrologMode &= ~InterruptMode; PrologMode &= ~InterruptMode;
ProcessSIGINT(); ProcessSIGINT();
PrologMode &= ~ConsoleGetcMode;
newline = TRUE; newline = TRUE;
if (PrologMode & AbortMode) { if (PrologMode & AbortMode) {
Error(PURE_ABORT, TermNil, NULL);
ErrorMessage = "Abort"; ErrorMessage = "Abort";
return(console_post_process_read_char(EOF, s, sno)); return(console_post_process_read_char(EOF, s, sno));
} }
goto restart; goto restart;
} else {
PrologMode &= ~ConsoleGetcMode;
} }
return(console_post_process_read_char(ch, s, sno)); return(console_post_process_read_char(ch, s, sno));
} }

23
C/sysbits.c
View File

@ -1069,10 +1069,18 @@ InteractSIGINT(int ch) {
switch (ch) { switch (ch) {
case 'a': case 'a':
/* abort computation */ /* abort computation */
/* we can't do a direct abort, so ask the system to do if (PrologMode & ConsoleGetcMode) {
it for us */ PrologMode |= AbortMode;
p_creep(); } else {
PrologMode |= AbortMode; getc(stdin);
Error(PURE_ABORT, TermNil, "");
/* in case someone mangles the P register */
#if _MSC_VER || defined(__MINGW32__)
/* don't even think about trying this */
#else
siglongjmp (RestartEnv, 1);
#endif
}
return(-1); return(-1);
case 'c': case 'c':
/* continue */ /* continue */
@ -1177,7 +1185,7 @@ ProcessSIGINT(void)
do { do {
#if HAVE_LIBREADLINE #if HAVE_LIBREADLINE
if (_line != (char *) NULL) { if ((PrologMode & ConsoleGetcMode) && _line != (char *) NULL) {
ch = _line[0]; ch = _line[0];
free(_line); free(_line);
_line = NULL; _line = NULL;
@ -1188,6 +1196,7 @@ ProcessSIGINT(void)
continue; continue;
} else { } else {
ch = _line[0]; ch = _line[0];
free(_line); free(_line);
_line = NULL; _line = NULL;
} }
@ -1221,10 +1230,10 @@ HandleSIGINT (int sig)
InteractSIGINT('e'); InteractSIGINT('e');
} }
#endif #endif
if (in_getc || (PrologMode & CritMode)) { if (PrologMode & (CritMode|ConsoleGetcMode)) {
PrologMode |= InterruptMode; PrologMode |= InterruptMode;
#if HAVE_LIBREADLINE #if HAVE_LIBREADLINE
if (in_getc) { if (PrologMode & ConsoleGetcMode) {
fprintf(stderr, "Action (h for help): "); fprintf(stderr, "Action (h for help): ");
#if HAVE_RL_SET_PROMPT #if HAVE_RL_SET_PROMPT
rl_set_prompt("Action (h for help): "); rl_set_prompt("Action (h for help): ");

3
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto * * File: Yap.proto *
* mods: * * mods: *
* comments: Function declarations for YAP * * comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.10 2002-02-11 20:46:41 stasinos Exp $ * * version: $Id: Yapproto.h,v 1.11 2002-02-12 18:24:20 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* prototype file for Yap */ /* prototype file for Yap */
@ -255,6 +255,7 @@ void STD_PROTO(InitSysPreds,(void));
int STD_PROTO(TrueFileName, (char *, char *, int)); int STD_PROTO(TrueFileName, (char *, char *, int));
int STD_PROTO(ProcessSIGINT,(void)); int STD_PROTO(ProcessSIGINT,(void));
double STD_PROTO(yap_random, (void)); double STD_PROTO(yap_random, (void));
void STD_PROTO(set_fpu_exceptions, (int));
/* tracer.c */ /* tracer.c */
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER

5
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 * * File: Yap.h.m4 *
* mods: * * mods: *
* comments: main header file for YAP * * comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.20 2002-02-04 16:12:54 vsc Exp $ * * version: $Id: Yap.h.m4,v 1.21 2002-02-12 18:24:20 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#include "config.h" #include "config.h"
@ -767,7 +767,8 @@ typedef enum {
CritMode = 4, /* If we are meddling with the heap */ CritMode = 4, /* If we are meddling with the heap */
AbortMode = 8, /* expecting to abort */ AbortMode = 8, /* expecting to abort */
InterruptMode = 16, /* under an interrupt */ InterruptMode = 16, /* under an interrupt */
InErrorMode = 32 /* under an interrupt */ InErrorMode = 32, /* under an interrupt */
ConsoleGetcMode = 64 /* blocked reading from console */
} prolog_exec_mode; } prolog_exec_mode;
extern prolog_exec_mode PrologMode; extern prolog_exec_mode PrologMode;

13
pl/boot.yap
View File

@ -886,13 +886,12 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
'$change_module'(M0). '$change_module'(M0).
'$consult'(X) :- '$consult'(X) :-
'$find_in_path'(X,Y,consult(X)), '$find_in_path'(X,Y,consult(X)),
( '$open'(Y,'$csult',Stream,0), !, '$open'(Y,'$csult',Stream,0), !,
'$record_loaded'(Stream), '$record_loaded'(Stream),
'$consult'(X,Stream), '$consult'(X,Stream),
'$close'(Stream) '$close'(Stream).
; '$consult'(X) :-
throw(error(permission_error(input,stream,Y),consult(X))) throw(error(permission_error(input,stream,X),consult(X))).
).
'$consult'(F,Stream) :- '$consult'(F,Stream) :-

40
pl/consult.yap
View File

@ -31,23 +31,21 @@ ensure_loaded(V) :-
'$change_module'(M0). '$change_module'(M0).
'$ensure_loaded'(X) :- '$ensure_loaded'(X) :-
'$find_in_path'(X,Y,ensure_loaded(X)), '$find_in_path'(X,Y,ensure_loaded(X)),
( '$open'(Y, '$csult', Stream, 0), !, '$open'(Y, '$csult', Stream, 0), !,
( '$loaded'(Stream) -> ( '$loaded'(Stream) ->
( '$consulting_file_name'(Stream,TFN), ( '$consulting_file_name'(Stream,TFN),
'$recorded'('$module','$module'(TFN,M,P),_) -> '$recorded'('$module','$module'(TFN,M,P),_) ->
'$current_module'(T), '$import'(P,M,T) '$current_module'(T), '$import'(P,M,T)
; ;
true true
) )
;
'$record_loaded'(Stream),
'$reconsult'(X,Stream)
),
'$close'(Stream)
; ;
'$record_loaded'(Stream),
throw(error(permission_error(input,stream,X),ensure_loaded(X))) '$reconsult'(X,Stream)
). ),
'$close'(Stream).
'$ensure_loaded'(X) :-
throw(error(permission_error(input,stream,X),ensure_loaded(X))).
compile(P) :- compile(P) :-
@ -87,12 +85,12 @@ reconsult(Fs) :-
'$reconsult'(Fs). '$reconsult'(Fs).
'$reconsult'(X) :- '$reconsult'(X) :-
'$find_in_path'(X,Y,reconsult(X)), '$find_in_path'(X,Y,reconsult(X)),
( '$open'(Y,'$csult',Stream,0), !, '$open'(Y,'$csult',Stream,0), !,
'$record_loaded'(Stream), '$record_loaded'(Stream),
'$reconsult'(X,Stream), '$close'(Stream) '$reconsult'(X,Stream),
; '$close'(Stream).
throw(error(permission_error(input,stream,X),reconsult(X))) '$reconsult'(X) :-
). throw(error(permission_error(input,stream,X),reconsult(X))).
'$reconsult'(F,Stream) :- '$reconsult'(F,Stream) :-
'$getcwd'(OldD), '$getcwd'(OldD),

2
pl/errors.yap
View File

@ -50,7 +50,7 @@ print_message(Level, Mss) :-
'$print_message'(error,error(Msg,Where)) :- '$print_message'(error,error(Msg,Where)) :-
'$output_error_message'(Msg, Where), !. '$output_error_message'(Msg, Where), !.
'$print_message'(error,Throw) :- '$print_message'(error,Throw) :-
'$format'(user_error,"[ No handler for ball ~w ]~n", [Throw]). '$format'(user_error,"[ No handler for error ~w ]~n", [Throw]).
'$print_message'(informational,M) :- '$print_message'(informational,M) :-
( '$get_value'('$verbose',on) -> ( '$get_value'('$verbose',on) ->
'$do_print_message'(M) ; '$do_print_message'(M) ;

60
pl/modules.yap
View File

@ -34,12 +34,15 @@ use_module(M) :-
'$use_module'(F), '$use_module'(F),
'$change_module'(M0). '$change_module'(M0).
'$use_module'(File) :- '$use_module'(File) :-
'$find_in_path'(File,X,use_module(File)), '$find_in_path'(File,X,use_module(File)), !,
( '$recorded'('$module','$module'(_,X,Publics),_) -> ( '$recorded'('$module','$module'(_,X,Publics),_) ->
'$use_module'(File,Publics) '$use_module'(File,Publics)
; ;
'$ensure_loaded'(File) '$ensure_loaded'(File)
). ).
'$use_module'(File) :-
throw(error(permission_error(input,stream,File),use_module(File))).
use_module(M,I) :- use_module(M,I) :-
'$use_module'(M, I). '$use_module'(M, I).
@ -55,8 +58,8 @@ use_module(M,I) :-
'$change_module'(M0). '$change_module'(M0).
'$use_module'(File,Imports) :- '$use_module'(File,Imports) :-
'$current_module'(M), '$current_module'(M),
'$find_in_path'(File,X,use_module(File,Imports)), '$find_in_path'(File,X,use_module(File,Imports)), !,
( '$open'(X,'$csult',Stream,0), !, '$open'(X,'$csult',Stream,0), !,
'$consulting_file_name'(Stream,TrueFileName), '$consulting_file_name'(Stream,TrueFileName),
( '$loaded'(Stream) -> true ( '$loaded'(Stream) -> true
; ;
@ -72,10 +75,9 @@ use_module(M,I) :-
; ;
'$format'(user_error,"[ use_module/2 can not find a module in file ~w]~n",File), '$format'(user_error,"[ use_module/2 can not find a module in file ~w]~n",File),
fail fail
) ).
; '$use_module'(File,Imports) :-
throw(error(permission_error(input,stream,X),use_module(X,Imports))) throw(error(permission_error(input,stream,File),use_module(File,Imports))).
).
use_module(Mod,F,I) :- use_module(Mod,F,I) :-
'$use_module'(Mod,F,I). '$use_module'(Mod,F,I).
@ -87,28 +89,32 @@ use_module(Mod,F,I) :-
'$use_module'(Module,File,Imports), '$use_module'(Module,File,Imports),
'$change_module'(M0). '$change_module'(M0).
'$use_module'(Module,File,Imports) :- '$use_module'(Module,File,Imports) :-
'$current_module'(M),
'$find_in_path'(File,X,use_module(Module,File,Imports)), '$find_in_path'(File,X,use_module(Module,File,Imports)),
( '$open'(X,'$csult',Stream,0), !, '$open'(X,'$csult',Stream,0), !,
'$consulting_file_name'(Stream,TrueFileName), '$consulting_file_name'(Stream,TrueFileName),
( '$loaded'(Stream) -> true '$current_module'(M),
; (
'$record_loaded'(Stream), '$loaded'(Stream)
% the following avoids import of all public predicates ->
'$recorda'('$importing','$importing'(TrueFileName),R), true
'$reconsult'(File,Stream) ;
), '$record_loaded'(Stream),
'$close'(Stream), % the following avoids import of all public predicates
( var(R) -> true; erased(R) -> true; erase(R)), '$recorda'('$importing','$importing'(TrueFileName),R),
( '$recorded'('$module','$module'(TrueFileName,Module,Publics),_) -> '$reconsult'(File,Stream)
'$use_preds'(Imports,Publics,Module,M) ),
; '$close'(Stream),
'$format'(user_error,"[ use_module/2 can not find module ~w in file ~w]~n",[Module,File]), ( var(R) -> true; erased(R) -> true; erase(R)),
fail (
) '$recorded'('$module','$module'(TrueFileName,Module,Publics),_)
; ->
throw(error(permission_error(input,stream,library(X)),use_module(Module,File,Imports))) '$use_preds'(Imports,Publics,Module,M)
). ;
'$format'(user_error,"[ use_module/2 can not find module ~w in file ~w]~n",[Module,File]),
fail
).
'$use_module'(Module,File,Imports) :-
throw(error(permission_error(input,stream,File),use_module(Module,File,Imports))).
'$consulting_file_name'(Stream,F) :- '$consulting_file_name'(Stream,F) :-
'$file_name'(Stream, F). '$file_name'(Stream, F).