1/* exp_trap.c - Expect's trap command
2
3Written by: Don Libes, NIST, 9/1/93
4
5Design and implementation of this program was paid for by U.S. tax
6dollars.  Therefore it is public domain.  However, the author and NIST
7would appreciate credit if this program or parts of it are used.
8
9*/
10
11#include "expect_cf.h"
12
13#include <stdio.h>
14#include <signal.h>
15#include <sys/types.h>
16
17#ifdef HAVE_SYS_WAIT_H
18#include <sys/wait.h>
19#endif
20#ifdef HAVE_STRING_H
21#include <string.h>
22#endif
23
24#if defined(SIGCLD) && !defined(SIGCHLD)
25#define SIGCHLD SIGCLD
26#endif
27
28#include "tcl.h"
29
30#include "exp_rename.h"
31#include "exp_prog.h"
32#include "exp_command.h"
33#include "exp_log.h"
34
35#ifdef TCL_DEBUGGER
36#include "tcldbg.h"
37#endif
38
39#define NO_SIG 0
40
41static struct trap {
42	char *action;		/* Tcl command to execute upon sig */
43				/* Each is handled by the eval_trap_action */
44	int mark;		/* TRUE if signal has occurred */
45	Tcl_Interp *interp;	/* interp to use or 0 if we should use the */
46				/* interpreter active at the time the sig */
47				/* is processed */
48	int code;		/* return our new code instead of code */
49				/* available when signal is processed */
50	CONST char *name;	/* name of signal */
51	int reserved;		/* if unavailable for trapping */
52} traps[NSIG];
53
54int sigchld_count = 0;	/* # of sigchlds caught but not yet processed */
55
56static int eval_trap_action();
57
58static int got_sig;		/* this records the last signal received */
59				/* it is only a hint and can be wiped out */
60				/* by multiple signals, but it will always */
61				/* be left with a valid signal that is */
62				/* pending */
63
64static Tcl_AsyncHandler async_handler;
65
66static CONST char *
67signal_to_string(sig)
68int sig;
69{
70	if (sig <= 0 || sig > NSIG) return("SIGNAL OUT OF RANGE");
71	return(traps[sig].name);
72}
73
74/* current sig being processed by user sig handler */
75static int current_sig = NO_SIG;
76
77int exp_nostack_dump = FALSE;	/* TRUE if user has requested unrolling of */
78				/* stack with no trace */
79
80
81
82/*ARGSUSED*/
83static int
84tophalf(clientData,interp,code)
85ClientData clientData;
86Tcl_Interp *interp;
87int code;
88{
89	struct trap *trap;	/* last trap processed */
90	int rc;
91	int i;
92	Tcl_Interp *sig_interp;
93
94	expDiagLog("sighandler: handling signal(%d)\r\n",got_sig);
95
96	if (got_sig <= 0 || got_sig >= NSIG) {
97		expErrorLog("caught impossible signal %d\r\n",got_sig);
98		abort();
99	}
100
101	/* start to work on this sig.  got_sig can now be overwritten */
102	/* and it won't cause a problem */
103	current_sig = got_sig;
104	trap = &traps[current_sig];
105
106	trap->mark = FALSE;
107
108	/* decrement below looks dangerous */
109	/* Don't we need to temporarily block bottomhalf? */
110	if (current_sig == SIGCHLD) {
111		sigchld_count--;
112		expDiagLog("sigchld_count-- == %d\n",sigchld_count);
113	}
114
115	if (!trap->action) {
116		/* In this one case, we let ourselves be called when no */
117		/* signaler predefined, since we are calling explicitly */
118		/* from another part of the program, and it is just simpler */
119		if (current_sig == 0) return code;
120		expErrorLog("caught unexpected signal: %s (%d)\r\n",
121			signal_to_string(current_sig),current_sig);
122		abort();
123	}
124
125	if (trap->interp) {
126		/* if trap requested original interp, use it */
127		sig_interp = trap->interp;
128	} else if (interp) {
129		/* else if another interp is available, use it */
130		sig_interp = interp;
131	} else {
132		/* fall back to exp_interp */
133		sig_interp = exp_interp;
134	}
135
136	rc = eval_trap_action(sig_interp,current_sig,trap,code);
137	current_sig = NO_SIG;
138
139	/*
140	 * scan for more signals to process
141	 */
142
143	/* first check for additional SIGCHLDs */
144	if (sigchld_count) {
145		got_sig = SIGCHLD;
146		traps[SIGCHLD].mark = TRUE;
147		Tcl_AsyncMark(async_handler);
148	} else {
149		got_sig = -1;
150		for (i=1;i<NSIG;i++) {
151			if (traps[i].mark) {
152				got_sig = i;
153				Tcl_AsyncMark(async_handler);
154				break;
155			}
156		}
157	}
158	return rc;
159}
160
161#ifdef REARM_SIG
162int sigchld_sleep;
163static int rearm_sigchld = FALSE;	/* TRUE if sigchld needs to be */
164					/* rearmed (i.e., because it has */
165					/* just gone off) */
166static int rearming_sigchld = FALSE;
167#endif
168
169/* called upon receipt of a user-declared signal */
170static void
171bottomhalf(sig)
172int sig;
173{
174#ifdef REARM_SIG
175	/*
176	 * tiny window of death if same signal should arrive here
177	 * before we've reinstalled it
178	 */
179
180	/* In SV, sigchld must be rearmed after wait to avoid recursion */
181	if (sig != SIGCHLD) {
182		signal(sig,bottomhalf);
183	} else {
184		/* request rearm */
185		rearm_sigchld = TRUE;
186		if (rearming_sigchld) sigchld_sleep = TRUE;
187	}
188#endif
189
190	traps[sig].mark = TRUE;
191	got_sig = sig;		/* just a hint - can be wiped out by another */
192	Tcl_AsyncMark(async_handler);
193
194	/* if we are called while this particular async is being processed */
195	/* original async_proc will turn off "mark" so that when async_proc */
196	/* is recalled, it will see that nothing was left to do */
197
198	/* In case of SIGCHLD though, we must recall it as many times as
199	 * we have received it.
200	 */
201	if (sig == SIGCHLD) {
202		sigchld_count++;
203	}
204#if 0
205	/* if we are doing an i_read, restart it */
206#ifdef HAVE_SIGLONGJMP
207      if (env_valid && (sig != 0)) siglongjmp(env,2);
208#else
209      if (env_valid && (sig != 0)) longjmp(env,2);
210#endif  /* HAVE_SIGLONGJMP */
211#endif /* 0 */
212}
213
214/*ARGSUSED*/
215void
216exp_rearm_sigchld(interp)
217Tcl_Interp *interp;
218{
219#ifdef REARM_SIG
220	if (rearm_sigchld) {
221		rearm_sigchld = FALSE;
222		rearming_sigchld = TRUE;
223		signal(SIGCHLD,bottomhalf);
224	}
225
226	rearming_sigchld = FALSE;
227
228	/* if the rearming immediately caused another SIGCHLD, slow down */
229	/* It's probably one of Tcl's intermediary pipeline processes that */
230	/* Tcl hasn't caught up with yet. */
231	if (sigchld_sleep) {
232		exp_dsleep(interp,0.2);
233		sigchld_sleep = FALSE;
234	}
235#endif
236}
237
238
239void
240exp_init_trap()
241{
242	int i;
243
244	for (i=1;i<NSIG;i++) {
245		traps[i].name = Tcl_SignalId(i);
246		traps[i].action = 0;
247		traps[i].reserved = FALSE;
248	}
249
250	/*
251	 * fix up any special cases
252	 */
253
254#if defined(SIGCLD)
255	/* Tcl names it SIGCLD, not good for portable scripts */
256	traps[SIGCLD].name = "SIGCHLD";
257#endif
258#if defined(SIGALRM)
259	traps[SIGALRM].reserved = TRUE;
260#endif
261#if defined(SIGKILL)
262	traps[SIGKILL].reserved = TRUE;
263#endif
264#if defined(SIGSTOP)
265	traps[SIGSTOP].reserved = TRUE;
266#endif
267
268	async_handler = Tcl_AsyncCreate(tophalf,(ClientData)0);
269
270}
271
272/* given signal index or name as string, */
273/* returns signal index or -1 if bad arg */
274int
275exp_string_to_signal(interp,s)
276Tcl_Interp *interp;
277char *s;
278{
279	int sig;
280	CONST char *name;
281
282	/* try interpreting as an integer */
283	if (1 == sscanf(s,"%d",&sig)) {
284		if (sig > 0 && sig < NSIG) return sig;
285	} else {
286		/* try interpreting as a string */
287		for (sig=1;sig<NSIG;sig++) {
288			name = traps[sig].name;
289			if (streq(s,name) || streq(s,name+3)) return(sig);
290		}
291	}
292
293	exp_error(interp,"invalid signal %s",s);
294
295	return -1;
296}
297
298/*ARGSUSED*/
299int
300Exp_TrapObjCmd(clientData, interp, objc, objv)
301ClientData clientData;
302Tcl_Interp *interp;
303int objc;
304Tcl_Obj *CONST objv[];
305{
306	char *action = 0;
307	int n;		/* number of signals in list */
308	Tcl_Obj **list;	/* list of signals */
309	char *arg;
310	int len;	/* length of action */
311	int i;
312	int show_name = FALSE;	/* if user asked for current sig by name */
313	int show_number = FALSE;/* if user asked for current sig by number */
314	int show_max = FALSE;	/* if user asked for NSIG-1 */
315	int rc = TCL_OK;
316	int new_code = FALSE;	/* if action result should overwrite orig */
317	Tcl_Interp *new_interp = interp;/* interp in which to evaluate */
318					/* action when signal occurs */
319
320	objc--; objv++;
321
322	while (objc) {
323	  arg = Tcl_GetString(*objv);
324
325		if (streq(arg,"-code")) {
326			objc--; objv++;
327			new_code = TRUE;
328		} else if (streq(arg,"-interp")) {
329			objc--; objv++;
330			new_interp = 0;
331		} else if (streq(arg,"-name")) {
332			objc--; objv++;
333			show_name = TRUE;
334		} else if (streq(arg,"-number")) {
335			objc--; objv++;
336			show_number = TRUE;
337		} else if (streq(arg,"-max")) {
338			objc--; objv++;
339			show_max = TRUE;
340		} else break;
341	}
342
343	if (show_name || show_number || show_max) {
344		if (objc > 0) goto usage_error;
345		if (show_max) {
346		  Tcl_SetObjResult(interp,Tcl_NewIntObj(NSIG-1));
347		}
348
349		if (current_sig == NO_SIG) {
350		  Tcl_SetResult(interp,"no signal in progress",TCL_STATIC);
351		  return TCL_ERROR;
352		}
353		if (show_name) {
354		  /* skip over "SIG" */
355		  /* TIP 27: Casting away the CONST should be ok because of TCL_STATIC
356		   */
357		  Tcl_SetResult(interp,(char*)signal_to_string(current_sig) + 3,TCL_STATIC);
358		} else {
359		  Tcl_SetObjResult(interp,Tcl_NewIntObj(current_sig));
360		}
361		return TCL_OK;
362	}
363
364	if (objc == 0 || objc > 2) goto usage_error;
365
366	if (objc == 1) {
367		int sig = exp_string_to_signal(interp,arg);
368		if (sig == -1) return TCL_ERROR;
369
370		if (traps[sig].action) {
371			Tcl_SetResult(interp,traps[sig].action,TCL_STATIC);
372		} else {
373			Tcl_SetResult(interp,"SIG_DFL",TCL_STATIC);
374		}
375		return TCL_OK;
376	}
377
378	action = arg;
379
380	/* objv[1] is the list of signals - crack it open */
381	if (TCL_OK != Tcl_ListObjGetElements(interp,objv[1],&n,&list)) {
382	  return TCL_ERROR;
383	}
384
385	for (i=0;i<n;i++) {
386	  char *s;
387	  int sig;
388
389	  s = Tcl_GetString(list[i]);
390
391		sig = exp_string_to_signal(interp,s);
392		if (sig == -1) {
393			rc = TCL_ERROR;
394			break;
395		}
396
397		if (traps[sig].reserved) {
398			exp_error(interp,"cannot trap %s",signal_to_string(sig));
399			rc = TCL_ERROR;
400			break;
401		}
402
403		expDiagLog("trap: setting up signal %d (\"%s\")\r\n",sig,s);
404		if (traps[sig].action) ckfree(traps[sig].action);
405		if (streq(action,"SIG_DFL")) {
406			/* should've been free'd by now if nec. */
407			traps[sig].action = 0;
408			signal(sig,SIG_DFL);
409#ifdef REARM_SIG
410			if (sig == SIGCHLD)
411				rearm_sigchld = FALSE;
412#endif /*REARM_SIG*/
413		} else {
414			len = 1 + strlen(action);
415			traps[sig].action = ckalloc(len);
416			memcpy(traps[sig].action,action,len);
417			traps[sig].interp = new_interp;
418			traps[sig].code = new_code;
419			if (streq(action,"SIG_IGN")) {
420				signal(sig,SIG_IGN);
421			} else signal(sig,bottomhalf);
422		}
423	}
424	/* It is no longer necessary to free the split list since it */
425	/* is still owned by Tcl, yes? */
426	/*	ckfree((char *)list); */
427	return(rc);
428 usage_error:
429	exp_error(interp,"usage: trap [command or SIG_DFL or SIG_IGN] {list of signals}");
430	return TCL_ERROR;
431}
432
433/* called by tophalf() to process the given signal */
434static int
435eval_trap_action(interp,sig,trap,oldcode)
436Tcl_Interp *interp;
437int sig;
438struct trap *trap;
439int oldcode;
440{
441	int code_flag;
442	int newcode;
443	Tcl_Obj *eip;   /* errorInfo */
444	Tcl_Obj *ecp;	/* errorCode */
445	Tcl_Obj *irp;	/* interp's result */
446
447	expDiagLogU("async event handler: Tcl_Eval(");
448	expDiagLogU(trap->action);
449	expDiagLogU(")\r\n");
450
451	/* save to prevent user from redefining trap->code while trap */
452	/* is executing */
453	code_flag = trap->code;
454
455	if (!code_flag) {
456		/*
457		 * save return values
458		 */
459
460		eip = Tcl_GetVar2Ex(interp,"errorInfo","",TCL_GLOBAL_ONLY);
461		if (eip) eip = Tcl_DuplicateObj(eip);
462		ecp = Tcl_GetVar2Ex(interp,"errorCode","",TCL_GLOBAL_ONLY);
463		if (ecp) ecp = Tcl_DuplicateObj(ecp);
464		irp = Tcl_GetObjResult(interp);
465		if (irp) irp = Tcl_DuplicateObj(irp);
466	}
467
468	newcode = Tcl_GlobalEval(interp,trap->action);
469
470	/*
471	 * if new code is to be ignored (usual case - see "else" below)
472	 *	allow only OK/RETURN from trap, otherwise complain
473	 */
474
475	if (code_flag) {
476		expDiagLog("return value = %d for trap %s, action ",newcode,signal_to_string(sig));
477		expDiagLogU(trap->action);
478		expDiagLogU("\r\n");
479		if (0 != strcmp(Tcl_GetStringResult(interp),"")) {
480
481			/*
482			 * Check errorinfo and see if it contains -nostack.
483			 * This shouldn't be necessary, but John changed the
484			 * top level interp so that it distorts arbitrary
485			 * return values into TCL_ERROR, so by the time we
486			 * get back, we'll have lost the value of errorInfo
487			 */
488
489			eip = Tcl_GetVar2Ex(interp,"errorInfo","",TCL_GLOBAL_ONLY);
490			if (eip) {
491			  exp_nostack_dump = (0 == strncmp("-nostack",Tcl_GetString(eip),8));
492			}
493		}
494	} else if (newcode != TCL_OK && newcode != TCL_RETURN) {
495	  if (newcode != TCL_ERROR) {
496	    exp_error(interp,"return value = %d for trap %s, action %s\r\n",newcode,signal_to_string(sig),trap->action);
497	  }
498	  Tcl_BackgroundError(interp);
499	}
500
501	if (!code_flag) {
502		/*
503		 * restore values
504		 */
505		Tcl_ResetResult(interp);	/* turns off Tcl's internal */
506		   /* flags: ERR_IN_PROGRESS, ERROR_CODE_SET */
507		   /* This also wipes clean errorInfo/Code/result which is why */
508		   /* all the calls to Tcl_Dup earlier */
509
510		if (eip) {
511		  /* odd that Tcl doesn't have a call that does all this at once */
512		  int len;
513		  char *s = Tcl_GetStringFromObj(eip,&len);
514		  Tcl_AddObjErrorInfo(interp,s,len);
515		  Tcl_DecrRefCount(eip);
516		  /* we never incr'd it, but the code allows this */
517		} else {
518		  Tcl_UnsetVar(interp,"errorInfo",0);
519		}
520
521		/* restore errorCode.  Note that Tcl_AddErrorInfo (above) */
522		/* resets it to NONE.  If the previous value is NONE, it's */
523		/* important to avoid calling Tcl_SetErrorCode since this */
524		/* with cause Tcl to set its internal ERROR_CODE_SET flag. */
525		if (ecp) {
526		  if (!streq("NONE",Tcl_GetString(ecp)))
527		    Tcl_SetErrorCode(interp,ecp);
528		  /* we're just passing on the errorcode obj */
529		  /* presumably, Tcl will incr ref count */
530		} else {
531		  Tcl_UnsetVar(interp,"errorCode",0);
532		}
533
534		newcode = oldcode;
535
536		/* note that since newcode gets overwritten here by old code */
537		/* it is possible to return in the middle of a trap by using */
538		/* "return" (or "continue" for that matter)! */
539	}
540	return newcode;
541}
542
543static struct exp_cmd_data
544cmd_data[]  = {
545{"trap",	Exp_TrapObjCmd, 0,	(ClientData)EXP_SPAWN_ID_BAD,	0},
546{0}};
547
548void
549exp_init_trap_cmds(interp)
550Tcl_Interp *interp;
551{
552	exp_create_commands(interp,cmd_data);
553}
554
555