1 /* exp_trap.c - Expect's trap command
2
3 Written by: Don Libes, NIST, 9/1/93
4
5 Design and implementation of this program was paid for by U.S. tax
6 dollars. Therefore it is public domain. However, the author and NIST
7 would 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
41 static 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
54 int sigchld_count = 0; /* # of sigchlds caught but not yet processed */
55
56 static int eval_trap_action();
57
58 static 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
64 static Tcl_AsyncHandler async_handler;
65
66 static CONST char *
signal_to_string(sig)67 signal_to_string(sig)
68 int 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 */
75 static int current_sig = NO_SIG;
76
77 int exp_nostack_dump = FALSE; /* TRUE if user has requested unrolling of */
78 /* stack with no trace */
79
80
81
82 /*ARGSUSED*/
83 static int
tophalf(clientData,interp,code)84 tophalf(clientData,interp,code)
85 ClientData clientData;
86 Tcl_Interp *interp;
87 int 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
162 int sigchld_sleep;
163 static int rearm_sigchld = FALSE; /* TRUE if sigchld needs to be */
164 /* rearmed (i.e., because it has */
165 /* just gone off) */
166 static int rearming_sigchld = FALSE;
167 #endif
168
169 /* called upon receipt of a user-declared signal */
170 static void
bottomhalf(sig)171 bottomhalf(sig)
172 int 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*/
215 void
exp_rearm_sigchld(interp)216 exp_rearm_sigchld(interp)
217 Tcl_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
239 void
exp_init_trap()240 exp_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 */
274 int
exp_string_to_signal(interp,s)275 exp_string_to_signal(interp,s)
276 Tcl_Interp *interp;
277 char *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*/
299 int
Exp_TrapObjCmd(clientData,interp,objc,objv)300 Exp_TrapObjCmd(clientData, interp, objc, objv)
301 ClientData clientData;
302 Tcl_Interp *interp;
303 int objc;
304 Tcl_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 */
434 static int
eval_trap_action(interp,sig,trap,oldcode)435 eval_trap_action(interp,sig,trap,oldcode)
436 Tcl_Interp *interp;
437 int sig;
438 struct trap *trap;
439 int 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
543 static struct exp_cmd_data
544 cmd_data[] = {
545 {"trap", Exp_TrapObjCmd, 0, (ClientData)EXP_SPAWN_ID_BAD, 0},
546 {0}};
547
548 void
exp_init_trap_cmds(interp)549 exp_init_trap_cmds(interp)
550 Tcl_Interp *interp;
551 {
552 exp_create_commands(interp,cmd_data);
553 }
554
555