This is exp_command.c in view mode; [Download] [Up]
/* command.c - expect commands, except for interact and expect
Written by: Don Libes, NIST, 2/6/90
Design and implementation of this program was paid for by U.S. tax
dollars. Therefore it is public domain. However, the author and NIST
would appreciate credit if this program or parts of it are used.
expect commands are as follows. They are discussed further in the man page
and the paper "expect: Curing Those Uncontrollable Fits of Interaction",
Proceedings of the Summer 1990 USENIX Conference, Anaheim, California.
Command Arguments Returns Sets
------- --------- ------- ----
close [-i spawn_id]
debug [-f file] expr
disconnect [status]
exit [status]
expect_after patlst body ...
expect_before patlst body ...
expect[_user] patlst body ... string matched expect_status
getpid pid
interact str-body pairs body return
interpreter TCL status
log_file [[-a] file]
log_user expr
match_max max match size
overlay [-] fd-spawn_id pairs
ready spawn_id set spawn_ids ready
send [...]
send_error [...]
send_user [...]
spawn program [...] pid spawn_id
strace level
system shell command TCL status
trap [[arg] siglist]
wait {pid status} or {-1 errno}
Variable of interest are:
Name Type Value Set by Default
---- ---- ----- ------ -------
expect_out str string matched expect cmds
spawn_id int currently spawned proc user/spawn cmd
timeout int seconds user 10
tty_spawn_id int spawn_id of /dev/tty expect itself
user_spawn_id int spawn_id of user expect itself 1
send_slow int/flt send -s size/time user
send_human 5 flts send -h timing user
*/
#include "exp_conf.h"
#include <stdio.h>
#include <sys/types.h>
/*#include <sys/time.h> seems to not be present on SVR3 systems */
/* and it's not used anyway as far as I can tell */
/*#include <sys/ioctl.h> Rob says no longer needed? */
#ifdef HAVE_SYS_FCNTL_H
# include <sys/fcntl.h>
#else
# include <fcntl.h>
#endif
#include <sys/file.h>
#include "exp_tty.h"
#ifdef HAVE_STROPTS_H
# include <sys/stropts.h>
#endif
#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif
#include <varargs.h>
#include <errno.h>
#include <signal.h>
#include <math.h> /* for log/pow computation in send -h */
#include <ctype.h> /* all this for ispunct! */
#include "tclInt.h" /* need OpenFile */
#include "tcl.h"
#include "string.h"
#include "exp_rename.h"
#include "exp_global.h"
#include "exp_command.h"
#include "exp_log.h"
#include "exp_event.h"
#include "exp_main.h"
#define SPAWN_ID_VARNAME "spawn_id"
int getptymaster();
int getptyslave();
extern exp_tty tty_current, tty_cooked;
int exp_disconnected = FALSE; /* whether we are a disconnected process */
int exp_forked = FALSE; /* whether we are child process */
/* the following are just reserved addresses, to be used as ClientData */
/* args to be used to tell commands how they were called. */
/* The actual values won't be used, only the addresses, but I give them */
/* values out of my irrational fear the compiler might collapse them all. */
static int sendCD_error = 2; /* called as send_error */
static int sendCD_user = 3; /* called as send_user */
static int sendCD_proc = 4; /* called as send or send_spawn */
static int sendCD_tty = 6; /* called as send_tty */
struct f *fs = 0; /* process array (indexed by spawn_id's) */
int fd_max = -1; /* highest fd */
int expect_key; /* no need to initialize */
/* Do not terminate format strings with \n!!! */
/*VARARGS*/
void
exp_error(va_alist)
va_dcl
{
Tcl_Interp *interp;
char *fmt;
va_list args;
va_start(args);
interp = va_arg(args,Tcl_Interp *);
fmt = va_arg(args,char *);
vsprintf(interp->result,fmt,args);
va_end(args);
}
/* returns handle if fd is usable, 0 if not */
struct f *
exp_fd2f(interp,fd,opened,adjust,msg)
Tcl_Interp *interp;
int fd;
int opened; /* check not closed */
int adjust; /* adjust buffer sizes */
char *msg;
{
if (fd >= 0 && fd <= fd_max && (fs[fd].valid)) {
struct f *f = fs + fd;
/* following is a little tricky, do not be tempted do the */
/* 'usual' boolean simplification */
if ((!opened) || !f->user_closed) {
if ((!adjust) || (TCL_OK == exp_adjust(interp,f)))
return f;
}
}
exp_error(interp,"%s: invalid spawn id (%d)",msg,fd);
return(0);
}
#if 0
/* following routine is not current used, but might be later */
/* returns fd or -1 if no such entry */
static int
pid_to_fd(pid)
int pid;
{
int fd;
for (fd=0;fd<=fd_max;fd++) {
if (fs[fd].pid == pid) return(fd);
}
return 0;
}
#endif
/* Tcl needs commands in writable space */
static char close_cmd[] = "close";
/* prevent an fd from being allocated */
void
exp_busy(fd)
int fd;
{
int x = open("/dev/null",0);
if (x != fd) {
fcntl(x,F_DUPFD,fd);
close(x);
}
}
/* clean up any remnants of a spawned process */
void
exp_destroy(fd)
int fd;
{
if (!fs[fd].sys_closed) close(fd);
fs[fd].valid = FALSE; /* retire this slot */
}
int exp_close_count = 0;
int
exp_close(interp,fd)
Tcl_Interp *interp;
int fd;
{
char *argv[3];
struct f *f = exp_fd2f(interp,fd,1,0,"close");
if (!f) return(TCL_ERROR);
f->user_closed = TRUE;
if (f->tcl_handle) {
int rc;
argv[0] = close_cmd;
argv[1] = f->tcl_handle;
argv[2] = 0;
/* ClientData isn't used by Tcl_CloseCmd so we can afford */
/* to pass a 0, otherwise I don't know what we'd do! */
rc = Tcl_CloseCmd((ClientData)0,interp,2,argv);
f->sys_closed = TRUE;
free(f->tcl_handle);
f->tcl_handle = 0;
/* make it appear as if process has been waited for */
f->sys_waited = TRUE;
f->wait = 0;
if (rc != TCL_OK) return rc;
} else {
/* Ignore close errors. Some systems are really odd and */
/* return errors for no evident reason. Anyway, receiving */
/* an error upon pty-close doesn't mean anything anyway as */
/* far as I know. */
close(fd);
}
exp_close_count++;
if (f->buffer) {
free(f->buffer);
f->buffer = 0;
f->msize = 0;
f->size = 0;
f->printed = 0;
f->echoed = 0;
if (f->armed) {
exp_event_disarm(f-fs);
f->armed = FALSE;
}
free(f->lower);
}
f->armed = FALSE;
if (f->user_waited) {
exp_destroy(fd);
} else {
exp_busy(fd);
}
return(TCL_OK);
}
static void
fd_new(fd,pid)
int fd;
int pid;
{
int i, low;
struct f *newfs; /* temporary, so we don't lose old fs */
/* resize table if nec */
if (fd > fd_max) {
if (!fs) { /* no fd's yet allocated */
newfs = (struct f *)malloc(sizeof(struct f)*(fd+1));
low = 0;
} else { /* enlarge fd table */
newfs = (struct f *)realloc((char *)fs,sizeof(struct f)*(fd+1));
low = fd_max+1;
}
fs = newfs;
fd_max = fd;
for (i = low; i <= fd_max; i++) { /* init new fd entries */
fs[i].valid = FALSE;
}
}
/* this could happen if user does "spawn -open stdin" I suppose */
if (fs[fd].valid) return;
/* close down old table entry if nec */
fs[fd].pid = pid;
fs[fd].size = 0;
fs[fd].msize = 0;
fs[fd].buffer = 0;
fs[fd].printed = 0;
fs[fd].echoed = 0;
fs[fd].parity = exp_default_parity;
fs[fd].key = expect_key++;
fs[fd].force_read = FALSE;
fs[fd].armed = FALSE;
fs[fd].tcl_handle = 0;
fs[fd].umsize = exp_default_match_max;
fs[fd].valid = TRUE;
fs[fd].user_closed = FALSE;
fs[fd].sys_closed = FALSE;
fs[fd].user_waited = FALSE;
fs[fd].sys_waited = FALSE;
}
void
exp_init_spawn_id_vars(interp)
Tcl_Interp *interp;
{
Tcl_SetVar(interp,"user_spawn_id",USER_SPAWN_ID_LIT,0);
/* note that the user_spawn_id is NOT /dev/tty which could */
/* (at least in theory anyway) be later re-opened on a different */
/* fd, while stdin might have been redirected away from /dev/tty */
if (exp_dev_tty != -1) {
char dev_tty_str[10];
sprintf(dev_tty_str,"%d",exp_dev_tty);
Tcl_SetVar(interp,"tty_spawn_id",dev_tty_str,0);
}
}
void
exp_init_spawn_ids(interp)
Tcl_Interp *interp;
{
fd_new(0,EXP_NOPID);
fd_new(1,EXP_NOPID);
fd_new(2,EXP_NOPID);
if (exp_dev_tty != -1) {
fd_new(exp_dev_tty,getpid());
}
/* really should be in interpreter() but silly to do on every call */
exp_adjust(interp,&fs[0]);
}
/* arguments are passed verbatim to execvp() */
/*ARGSUSED*/
static int
cmdSpawn(clientData,interp,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
int slave;
int pid;
char **a;
/* tell Saber to ignore non-use of ttyfd */
/*SUPPRESS 591*/
int ttyfd;
int master;
int ttyinit = TRUE;
int ttycopy = TRUE;
int echo = TRUE;
int console = FALSE;
char *argv0 = argv[0];
char *openarg = 0;
OpenFile *filePtr;
char buf[4]; /* enough space for a string literal */
/* representing a file descriptor */
#if TCL_MAJOR_VERSION != 6
Tcl_DString dstring;
#endif
argc--; argv++;
for (;argc>0;argc--,argv++) {
if (streq(*argv,"-nottyinit")) {
ttyinit = FALSE;
} else if (streq(*argv,"-nottycopy")) {
ttycopy = FALSE;
} else if (streq(*argv,"-noecho")) {
echo = FALSE;
} else if (streq(*argv,"-console")) {
console = TRUE;
} else if (streq(*argv,"-open")) {
openarg = argv[1];
argc--; argv++;
} else break;
}
if (openarg && (argc != 0)) {
exp_error(interp,"usage: -open [fileXX]\n");
return TCL_ERROR;
}
if (!openarg && (argc == 0)) {
exp_error(interp,"usage: spawn program [args]");
return(TCL_ERROR);
}
if (!openarg) {
if (echo) {
Log(0,"%s ",argv0);
for (a = argv;*a;a++) {
Log(0,"%s ",*a);
}
nflog("\r\n",0);
}
if (0 > (master = getptymaster())) {
exp_error(interp,"too many programs spawned? - out of ptys");
return(TCL_ERROR);
}
} else {
if (echo) Log(0,"%s [open ...]\r\n",argv0);
if (TclGetOpenFile(interp, openarg, &filePtr) != TCL_OK) {
return TCL_ERROR;
}
master = fileno(filePtr->f);
}
/* much easier to set this, than remember all masters */
fcntl(master,F_SETFD,1); /* close on exec */
if (openarg) {
struct f *f;
fd_new(master,EXP_NOPID);
f = exp_fd2f(interp,master,0,0,(char *)0);
f->tcl_handle = ckalloc(strlen(openarg)+1);
/* save file# handle */
strcpy(f->tcl_handle,openarg);
/* save fd handle for output */
if (filePtr->f2) {
f->tcl_output = fileno(filePtr->f2);
fcntl(master,F_SETFD,1); /* close on exec */
} else {
f->tcl_output = master;
}
f->tcl_output = (filePtr->f2 ? fileno(filePtr->f2) : master);
/* tell user id of new process */
sprintf(buf,"%d",master);
Tcl_SetVar(interp,SPAWN_ID_VARNAME,buf,0);
sprintf(interp->result,"%d",EXP_NOPID);
debuglog("spawn: returns {%s}\r\n",interp->result);
return TCL_OK;
}
#if TCL_MAJOR_VERSION == 6
if (NULL == (argv[0] = Tcl_TildeSubst(interp,argv[0])))
return TCL_ERROR;
#else
if (NULL == (argv[0] = Tcl_TildeSubst(interp,argv[0],dstring))) {
Tcl_DStringFree(dstring);
return TCL_ERROR;
}
#endif
if ((pid = fork()) == -1) {
exp_error(interp,"fork: %s",sys_errlist[errno]);
return(TCL_ERROR);
}
if (pid) {
/* parent */
fd_new(master,pid);
#if TCL_MAJOR_VERSION != 6
Tcl_DStringFree(dstring);
#endif
#ifdef CRAY
setptypid(pid);
#endif
#ifdef HAVE_PTYTRAP
/* trap initial opens in a feeble attempt to not block */
/* the initially. If the process itself opens */
/* /dev/tty, such blocks will be trapped later */
/* during normal event processing */
/* initial slave open */
if (exp_wait_for_slave_open(master)) {
exp_error(interp,"failed to trap slave pty open");
return(TCL_ERROR);
}
/* open("/dev/tty"); */
if (exp_wait_for_slave_open(master)) {
exp_error(interp,"failed to trap slave pty open");
return(TCL_ERROR);
}
#endif
/* tell user id of new process */
sprintf(buf,"%d",master);
Tcl_SetVar(interp,SPAWN_ID_VARNAME,buf,0);
sprintf(interp->result,"%d",pid);
debuglog("spawn: returns {%s}\r\n",interp->result);
return(TCL_OK);
}
/* child process - do not return from here! all errors must exit() */
if (exp_dev_tty != -1) {
close(exp_dev_tty);
exp_dev_tty = -1;
}
#ifdef CRAY
(void) close(master);
#endif
/* ultrix (at least 4.1-2) fails to obtain controlling tty if setsid */
/* is called. setpgrp works though. */
#if defined(POSIX) && !defined(ultrix)
#define DO_SETSID
#endif
#ifdef __convex__
#define DO_SETSID
#endif
#ifdef DO_SETSID
setsid();
#else
#ifdef SYSV3
#ifndef CRAY
setpgrp();
#endif /* CRAY */
#else /* !SYSV3 */
#ifdef MIPS_BSD
/* required on BSD side of MIPS OS <jmsellen@watdragon.waterloo.edu> */
# include <sysv/sys.s>
syscall(SYS_setpgrp);
#endif
setpgrp(0,0);
/* setpgrp(0,getpid());*/ /* make a new pgrp leader */
ttyfd = open("/dev/tty", O_RDWR);
if (ttyfd >= 0) {
(void) ioctl(ttyfd, TIOCNOTTY, (char *)0);
(void) close(ttyfd);
}
#endif /* SYSV3 */
#endif /* DO_SETSID */
close(0);
close(1);
/* leave 2 around awhile for stderr-related stuff */
/* since we closed fd 0, open of pty slave must return fd 0 */
/* since getptyslave may have to run stty, (some of which work on fd */
/* 0 and some of which work on 1) do the dup's inside getptyslave. */
#define STTY_INIT "stty_init"
if (0 > (slave = getptyslave(ttycopy,ttyinit,get_var(STTY_INIT)))) {
errorlog("open(slave pty): %s\r\n",sys_errlist[errno]);
exit(-1);
}
/* sanity check */
if (slave != 0) {
errorlog("getptyslave: slave = %d but expected 0\n",slave);
exit(-1);
}
#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(sun)
/* 4.3+BSD way to acquire controlling terminal */
/* according to Stevens - Adv. Prog..., p 642 */
if (ioctl(0,TIOCSCTTY,(char *)0) < 0) {
errorlog("failed to get controlling terminal using TIOCSCTTY");
exit(-1);
}
#endif
#ifdef CRAY
(void) setsid();
(void) ioctl(0,TCSETCTTY,0);
(void) close(0);
if (open("/dev/tty", O_RDWR) < 0) {
errorlog("open(/dev/tty): %s\r\n",sys_errlist[errno]);
exit(-1);
}
(void) close(1);
(void) close(2);
(void) dup(0);
(void) dup(0);
setptyutmp(); /* create a utmp entry */
/* _CRAY2 code from Hal Peterson <hrp@cray.com>, Cray Research, Inc. */
#ifdef _CRAY2
/*
* Interpose a process between expect and the spawned child to
* keep the slave side of the pty open to allow time for expect
* to read the last output. This is a workaround for an apparent
* bug in the Unicos pty driver on Cray-2's under Unicos 6.0 (at
* least).
*/
if ((pid = fork()) == -1) {
errorlog("second fork: %s\r\n",sys_errlist[errno]);
exit(-1);
}
if (pid) {
/* Intermediate process. */
int status;
int timeout;
char *t;
/* How long should we wait? */
if (t = get_var("pty_timeout"))
timeout = atoi(t);
else if (t = get_var("timeout"))
timeout = atoi(t)/2;
else
timeout = 5;
/* Let the spawned process run to completion. */
while (wait(&status) < 0 && errno == EINTR)
/* empty body */;
/* Wait for the pty to clear. */
sleep(timeout);
/* Duplicate the spawned process's status. */
if (WIFSIGNALED(status))
kill(getpid(), WTERMSIG(status));
/* The kill may not have worked, but this will. */
exit(WEXITSTATUS(status));
}
#endif /* _CRAY2 */
#endif /* CRAY */
#ifdef TIOCCONS
if (console) {
int on = 1;
if (ioctl(0,TIOCCONS,(char *)&on) == -1) {
errorlog(stderr, "spawn %s: cannot open console, check permissions of /dev/console\n",argv[0]);
exit(-1);
}
}
#endif /* TIOCCONS */
/* by now, fd 0 and 1 point to slave pty, so fix 2 */
close(2);
fcntl(0,F_DUPFD,2); /* duplicate 0 onto 2 */
/* avoid fflush of cmdfile since this screws up the parents seek ptr */
/* There is no portable way to fclose a shared read-stream!!!! */
if (exp_cmdfile && (exp_cmdfile != stdin))
(void) close(fileno(exp_cmdfile));
if (logfile) (void) fclose(logfile);
if (debugfile) (void) fclose(debugfile);
/* (possibly multiple) masters are closed automatically due to */
/* earlier fcntl(,,CLOSE_ON_EXEC); */
(void) execvp(argv[0],argv);
/* Unfortunately, by now we've closed fd's to stderr, logfile and
debugfile.
The only reasonable thing to do is to send back the error as
part of the program output. This will be picked up in an
expect or interact command.
*/
errorlog("%s: %s\r\n",argv[0],sys_errlist[errno]);
exit(-1);
/*NOTREACHED*/
}
/*ARGSUSED*/
static int
cmdExpPid(clientData,interp,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
struct f *f;
int m = -1;
int argc_orig = argc;
char **argv_orig = argv;
argc--; argv++;
for (;argc>0;argc--,argv++) {
if (streq(*argv,"-i")) {
argc--; argv++;
if (*argv) {
exp_error(interp,"usage: -i spawn_id");
return TCL_ERROR;
}
m = atoi(*argv);
} else break;
}
if (m == -1) {
if (exp_update_master(interp,&m,0,0) == 0) return TCL_ERROR;
}
if (0 == (f = exp_fd2f(interp,m,1,0,"pid"))) return TCL_ERROR;
sprintf(interp->result,"%d",f->pid);
return TCL_OK;
}
/*ARGSUSED*/
static int
cmdGetpid(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
sprintf(interp->result,"%d",getpid());
return(TCL_OK);
}
/* returns current master (via out-parameter) */
/* returns f or 0, but note that since exp_fd2f calls tcl_error, this */
/* may be immediately followed by a "return(TCL_ERROR)"!!! */
struct f *
exp_update_master(interp,m,opened,adjust)
Tcl_Interp *interp;
int *m;
int opened;
int adjust;
{
char *s = exp_get_var(interp,SPAWN_ID_VARNAME);
*m = (s?atoi(s):USER_SPAWN_ID);
return(exp_fd2f(interp,*m,opened,adjust,(s?s:USER_SPAWN_ID_LIT)));
}
/*ARGSUSED*/
static int
cmdSystem(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
#define MAX_ARGLIST 10240
int i;
char buf[MAX_ARGLIST];
char *bufp = buf;
int total_len = 0, arg_len;
int stty_args_recognized = TRUE;
int stty_cmd = FALSE;
int cooked = FALSE;
int was_raw, was_echo;
if (argc == 1) return TCL_OK;
if (streq(argv[1],"stty")) {
stty_cmd = TRUE;
was_raw = exp_israw();
was_echo = exp_isecho();
}
if (argc > 2 && stty_cmd) {
exp_ioctled_devtty = TRUE;
for (i=2;i<argc;i++) {
if (streq(argv[i],"raw") ||
streq(argv[i],"-cooked")) {
exp_tty_raw(1);
} else if (streq(argv[i],"-raw") ||
streq(argv[i],"cooked")) {
cooked = TRUE;
exp_tty_raw(-1);
} else if (streq(argv[i],"echo")) {
exp_tty_echo(1);
} else if (streq(argv[i],"-echo")) {
exp_tty_echo(-1);
} else stty_args_recognized = FALSE;
}
/* if unknown args, fall thru and let real stty have a go */
if (stty_args_recognized) {
#ifdef POSIX
if (tcsetattr(exp_dev_tty,TCSADRAIN, &tty_current) == -1) {
#else
if (ioctl(exp_dev_tty, TCSETSW, &tty_current) == -1) {
#endif
if (exp_disconnected || (exp_dev_tty == -1) || !isatty(exp_dev_tty)) {
errorlog("system stty: impossible in this context\n");
errorlog("are you disconnected or in a batch, at, or cron script?");
/* user could've conceivably closed /dev/tty as well */
}
exp_error(interp,"system stty: ioctl(user): %s\r\n",sys_errlist[errno]);
return(TCL_ERROR);
}
if (stty_cmd) {
sprintf(interp->result,"%sraw %secho",
(was_raw?"":"-"),
(was_echo?"":"-"));
}
return(TCL_OK);
}
}
for (i = 1;i<argc;i++) {
total_len += (1 + (arg_len = strlen(argv[i])));
if (total_len > MAX_ARGLIST) {
exp_error(interp,"args too long (>=%d chars)",
total_len);
return(TCL_ERROR);
}
memcpy(bufp,argv[i],arg_len);
bufp += arg_len;
/* no need to check bounds, we accted for it earlier */
memcpy(bufp," ",1);
bufp += 1;
}
*(bufp-1) = '\0';
i = system(buf);
debuglog("system(%s) = %d\r\n",buf,i);
if (!stty_args_recognized) {
/* find out what weird options user asked for */
#ifdef POSIX
if (tcgetattr(exp_dev_tty, &tty_current) == -1) {
#else
if (ioctl(exp_dev_tty, TCGETS, &tty_current) == -1) {
#endif
errorlog("ioctl(get): %s\r\n",sys_errlist[errno]);
exp_exit(interp,-1);
}
if (cooked) {
/* find out user's new defn of 'cooked' */
tty_cooked = tty_current;
}
}
if (stty_cmd) {
sprintf(interp->result,"%sraw %secho",
(was_raw?"":"-"),
(was_echo?"":"-"));
}
/* Following the style of Tcl_ExecCmd, we can just return the */
/* raw result (appropriately shifted and masked) to Tcl */
return(0xff & (i>>8));
}
/* write exactly this many bytes, i.e. retry partial writes */
/* I don't know if this is necessary, but large sends might have this */
/* problem */
/* returns 0 for success, -1 for failure */
static int
exact_write(fd,buffer,rembytes)
int fd;
char *buffer;
int rembytes;
{
int cc;
while (rembytes) {
if (-1 == (cc = write(fd,buffer,rembytes))) return(-1);
/* if (0 == cc) return(-1); can't happen! */
buffer += cc;
rembytes -= cc;
}
return(0);
}
struct slow_arg {
int size;
long time; /* microseconds */
};
/* returns -1 failure, 0 if successful */
static int
get_slow_args(interp,x)
Tcl_Interp *interp;
struct slow_arg *x;
{
float ftime;
int sc; /* return from scanf */
char *s = exp_get_var(interp,"send_slow");
if (!s) {
exp_error(interp,"send -s: send_slow has no value");
return(-1);
}
if (2 != (sc = sscanf(s,"%d %f",&x->size,&ftime))) {
exp_error(interp,"send -s: found %d value(s) in send_slow but need 2",sc);
return(-1);
}
if (x->size <= 0) {
exp_error(interp,"send -s: size (%d) in send_slow must be positive", x->size);
return(-1);
}
x->time = ftime*1000000L;
if (x->time <= 0) {
exp_error(interp,"send -s: time (%f) in send_slow must be larger",ftime);
return(-1);
}
return(0);
}
/* returns 0 for success, -1 for failure */
static int
slow_write(fd,buffer,rembytes,arg)
int fd;
char *buffer;
int rembytes;
struct slow_arg *arg;
{
while (rembytes > 0) {
int len;
len = (arg->size<rembytes?arg->size:rembytes);
if (0 > exact_write(fd,buffer,len)) return(-1);
rembytes -= arg->size;
buffer += arg->size;
/* skip sleep after last write */
if (rembytes > 0) exp_usleep(arg->time);
}
return(0);
}
struct human_arg {
float alpha; /* average interarrival time in seconds */
float alpha_eow; /* as above but for eow transitions */
float c; /* shape */
float min, max;
};
/* returns -1 if error, 0 if success */
static int
get_human_args(interp,x)
Tcl_Interp *interp;
struct human_arg *x;
{
int sc; /* return from scanf */
char *s = exp_get_var(interp,"send_human");
if (!s) {
exp_error(interp,"send -h: send_human has no value");
return(-1);
}
if (5 != (sc = sscanf(s,"%f %f %f %f %f",
&x->alpha,&x->alpha_eow,&x->c,&x->min,&x->max))) {
exp_error(interp,"send -h: found %d value(s) in send_human but need 5",sc);
return(-1);
}
if (x->alpha < 0 || x->alpha_eow < 0) {
exp_error(interp,"send -h: average interarrival times (%f %f) must be non-negative in send_human", x->alpha,x->alpha_eow);
return(-1);
}
if (x->c <= 0) {
exp_error(interp,"send -h: variability (%f) in send_human must be positive",x->c);
return(-1);
}
x->c = 1/x->c;
if (x->min < 0) {
exp_error(interp,"send -h: minimum (%f) in send_human must be non-negative",x->min);
return(-1);
}
if (x->max < 0) {
exp_error(interp,"send -h: maximum (%f) in send_human must be non-negative",x->max);
return(-1);
}
if (x->max < x->min) {
exp_error(interp,"send -h: maximum (%f) must be >= minimum (%f) in send_human",x->max,x->min);
return(-1);
}
return(0);
}
/* Compute random numbers from 0 to 1, for expect's send -h */
/* This implementation sacrifices beauty for portability */
static float
unit_random()
{
/* current implementation is pathetic but works */
/* 99991 is largest prime in my CRC - can't hurt, eh? */
return((float)(1+(rand()%99991))/99991.0);
}
void
exp_init_unit_random()
{
srand(getpid());
}
/* This function is my implementation of the Weibull distribution. */
/* I've added a max time and an "alpha_eow" that captures the slight */
/* but noticable change in human typists when hitting end-of-word */
/* transitions. */
/* returns 0 for success, -1 for failure */
static int
human_write(fd,buffer,arg)
int fd;
char *buffer;
struct human_arg *arg;
{
char *sp;
float t;
float alpha;
int wc;
int in_word = TRUE;
debuglog("human_write: avg_arr=%f/%f 1/shape=%f min=%f max=%f\r\n",
arg->alpha,arg->alpha_eow,arg->c,arg->min,arg->max);
for (sp = buffer;*sp;sp++) {
/* use the end-of-word alpha at eow transitions */
if (in_word && (ispunct(*sp) || isspace(*sp)))
alpha = arg->alpha_eow;
else alpha = arg->alpha;
in_word = !(ispunct(*sp) || isspace(*sp));
t = alpha * pow(-log((double)unit_random()),arg->c);
/* enforce min and max times */
if (t<arg->min) t = arg->min;
else if (t>arg->max) t = arg->max;
/*fprintf(stderr,"\nwriting <%c> but first sleep %f seconds\n",*sp,t);*/
/* skip sleep before writing first character */
if (sp != buffer) exp_usleep((long)(t*1000000));
wc = write(fd,sp,1);
if (0 > wc) return(wc);
}
return(0);
}
struct exp_i *exp_i_pool = 0;
struct exp_fd_list *exp_fd_list_pool = 0;
#define EXP_I_INIT_COUNT 10
#define EXP_FD_INIT_COUNT 10
struct exp_i *
exp_new_i(interp)
Tcl_Interp *interp;
{
int n;
struct exp_i *i;
if (!exp_i_pool) {
/* none avail, generate some new ones */
exp_i_pool = i = (struct exp_i *)ckalloc(
EXP_I_INIT_COUNT * sizeof(struct exp_i));
for (n=0;n<EXP_I_INIT_COUNT-1;n++,i++) {
i->next = i+1;
}
i->next = 0;
}
/* now that we've made some, unlink one and give to user */
i = exp_i_pool;
exp_i_pool = exp_i_pool->next;
return i;
}
struct exp_fd_list *
exp_new_fd(interp,val)
Tcl_Interp *interp;
int val;
{
int n;
struct exp_fd_list *fd;
if (!exp_fd_list_pool) {
/* none avail, generate some new ones */
exp_fd_list_pool = fd = (struct exp_fd_list *)ckalloc(
EXP_FD_INIT_COUNT * sizeof(struct exp_fd_list));
for (n=0;n<EXP_FD_INIT_COUNT-1;n++,fd++) {
fd->next = fd+1;
}
fd->next = 0;
}
/* now that we've made some, unlink one and give to user */
fd = exp_fd_list_pool;
exp_fd_list_pool = exp_fd_list_pool->next;
fd->fd = val;
return fd;
}
void
exp_free_fd(fd_first)
struct exp_fd_list *fd_first;
{
struct exp_fd_list *fd, *penultimate;
if (!fd_first) return;
/* link entire chain back in at once by first finding last pointer */
/* making that point back to pool, and then resetting pool to this */
/* run to end */
for (fd = fd_first;fd;fd=fd->next) {
penultimate = fd;
}
penultimate->next = exp_fd_list_pool;
exp_fd_list_pool = fd_first;
}
void
exp_free_i(i)
struct exp_i *i;
{
if (i->next) exp_free_i(i->next);
exp_free_fd(i->fd_list);
/* here's the long form */
/* if dynamic & direct free(var) free(val) */
/* 1 1 1 */
/* 1 0 1 1 */
/* 0 1 */
/* 0 0 1 */
/* if i->variable was a bogus variable name, i->value might not be */
/* set, so test i->value to protect this */
if ((i->dynamic == i->direct) && i->value) free(i->value);
else if (i->dynamic) {
if (i->value) free(i->value);
free(i->variable);
}
i->next = exp_i_pool;
exp_i_pool = i;
}
/* generate a descriptor for a "-i" flag */
struct exp_i *
exp_new_i_complex(interp,/*direct,*/arg,dynamic)
Tcl_Interp *interp;
/*int direct;*/
char *arg;
int dynamic; /* if we have to copy the args */
/* should only need do this in expect_before/after */
{
struct exp_i *i;
char **stringp;
i = exp_new_i(interp);
/* i->direct = direct;*/
i->direct = isdigit(arg[0]) || (arg[0] == '-');
if (i->direct) {
stringp = &i->value;
} else {
i->value = 0;
stringp = &i->variable;
}
i->dynamic = dynamic;
if (dynamic) {
*stringp = ckalloc(strlen(arg)+1);
strcpy(*stringp,arg);
} else {
*stringp = arg;
}
i->next = 0;
i->fd_list = 0;
if (TCL_ERROR == exp_i_update(interp,i)) {
exp_free_i(i);
return 0;
}
return i;
}
void
exp_i_add_fd(interp,i,fd)
Tcl_Interp *interp;
struct exp_i *i;
int fd;
{
struct exp_fd_list *new_fd;
new_fd = exp_new_fd(interp,fd);
new_fd->next = i->fd_list;
i->fd_list = new_fd;
}
/* this routine assumes i->fd is meaningful */
void
exp_i_parse_fds(interp,i)
Tcl_Interp *interp;
struct exp_i *i;
{
char *p = i->value;
/* reparse it */
while (1) {
int m;
int negative = 0;
int valid_spawn_id = 0;
m = 0;
while (isspace(*p)) p++;
for (;;p++) {
if (*p == '-') negative = 1;
else if (isdigit(*p)) {
m = m*10 + (*p-'0');
valid_spawn_id = 1;
} else if (*p == '\0' || isspace(*p)) break;
}
/* we either have a spawn_id or whitespace at end of string */
/* skip whitespace end-of-string */
if (!valid_spawn_id) break;
if (negative) m = -m;
exp_i_add_fd(interp,i,m);
}
}
/* updates a single exp_i struct */
/* returns TCL_OK or TCL_ERROR */
int
exp_i_update(interp,i)
Tcl_Interp *interp;
struct exp_i *i;
{
char *p; /* string representation of list of spawn ids */
if (!i->direct) {
p = exp_get_var(interp,i->variable);
if (!p) {
exp_error(interp,"%s undefined",i->variable);
return TCL_ERROR;
}
if (i->value) {
if (streq(p,i->value)) return TCL_OK;
/* replace new value with old */
free(i->value);
}
i->value = ckalloc(strlen(p)+1);
strcpy(i->value,p);
exp_free_fd(i->fd_list);
i->fd_list = 0;
} else {
/* no free, because this should only be called on */
/* "direct" i's once */
i->fd_list = 0;
}
exp_i_parse_fds(interp,i);
return TCL_OK;
}
struct exp_i *
exp_new_i_simple(interp,fd)
Tcl_Interp *interp;
int fd;
{
struct exp_i *i;
i = exp_new_i(interp);
i->next = 0;
i->fd_list = 0;
i->direct = TRUE;
i->dynamic = FALSE;
exp_i_add_fd(interp,i,fd);
return i;
}
/*ARGSUSED*/
static int
cmdSendLog(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
char *string;
int len;
argv++;
argc--;
while (argc) {
if (streq(*argv,"--")) {
argc--; argv++;
break;
} else break;
}
if (argc != 1) {
exp_error(interp,"usage: send [args] string");
return TCL_ERROR;
}
string = *argv;
len = strlen(string);
if (debugfile) fwrite(string,1,len,debugfile);
if (logfile) fwrite(string,1,len,logfile);
return(TCL_OK);
}
/* I've rewritten this to be unbuffered. I did this so you could shove */
/* large files through "send". If you are concerned about efficiency */
/* you should quote all your send args to make them one single argument. */
/*ARGSUSED*/
static int
cmdSend(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
int m = -1; /* spawn id (master) */
int wc = 0; /* if negative, a write has failed */
int rc; /* final result of this procedure */
struct human_arg human_args;
struct slow_arg slow_args;
#define SEND_STYLE_PLAIN 0
#define SEND_STYLE_HUMAN 1
#define SEND_STYLE_SLOW 2
#define SEND_STYLE_ZERO 3
int send_style = SEND_STYLE_PLAIN;
int want_cooked = TRUE;
char *string; /* string to send */
int len; /* length of string to send */
int zeros; /* count of how many ascii zeros to send */
char *i_masters = 0;
struct exp_fd_list *fd;
struct exp_i *i;
argv++;
argc--;
while (argc) {
if (streq(*argv,"--")) {
argc--; argv++;
break;
} else if (streq(*argv,"-i")) {
argc--; argv++;
if (argc==0) {
exp_error(interp,"usage: -i spawn_id");
return(TCL_ERROR);
}
i_masters = *argv;
argc--; argv++;
continue;
} else if (streq(*argv,"-h")) {
argc--; argv++;
if (-1 == get_human_args(interp,&human_args))
return(TCL_ERROR);
send_style = SEND_STYLE_HUMAN;
} else if (streq(*argv,"-s")) {
argc--; argv++;
if (-1 == get_slow_args(interp,&slow_args))
return(TCL_ERROR);
send_style = SEND_STYLE_SLOW;
} else if (streq(*argv,"-0")) {
argc--; argv++;
if (!*argv) zeros = 1;
else {
zeros = atoi(*argv);
argc--; argv++;
if (zeros < 1) return TCL_OK;
}
send_style = SEND_STYLE_ZERO;
} else if (streq(*argv,"-raw")) {
argc--; argv++;
want_cooked = FALSE;
} else break;
}
if (send_style == SEND_STYLE_ZERO) {
string = "<zero(s)>";
} else {
if (argc != 1) {
exp_error(interp,"usage: send [args] string");
return TCL_ERROR;
}
string = *argv;
}
len = strlen(string);
if (clientData == &sendCD_user) m = 1;
else if (clientData == &sendCD_error) m = 2;
else if (clientData == &sendCD_tty) m = exp_dev_tty;
else if (!i_masters) {
/* we really do want to check if it is open */
/* but since stdin could be closed, we have to first */
/* get the fd and then convert it from 0 to 1 if necessary */
if (0 == exp_update_master(interp,&m,0,0))
return(TCL_ERROR);
}
/* if master != -1, then it holds desired master */
/* else i_masters does */
if (m != -1) {
i = exp_new_i_simple(interp,m);
} else {
i = exp_new_i_complex(interp /*,1*/ /*direct*/,i_masters,FALSE);
if (i == 0) return TCL_ERROR;
}
#define send_to_stderr (clientData == &sendCD_error)
#define send_to_proc (clientData == &sendCD_proc)
#define send_to_user ((clientData == &sendCD_user) || \
(clientData == &sendCD_tty))
if (send_to_proc) {
want_cooked = FALSE;
debuglog("send: sending {%s} to {",dprintify(string));
/* if closing brace doesn't appear, that's because an error */
/* was encountered before we could send it */
} else {
if (debugfile)
fwrite(string,1,len,debugfile);
if ((send_to_user && logfile_all) || logfile)
fwrite(string,1,len,logfile);
}
for (fd=i->fd_list;fd;fd=fd->next) {
m = fd->fd;
if (send_to_proc) {
debuglog(" %d ",m);
}
/* true if called as Send with user_spawn_id */
if (exp_is_stdinfd(m)) m = 1;
/* check validity of each - i.e., are they open */
if (0 == exp_fd2f(interp,m,1,0,"send")) {
rc = TCL_ERROR;
goto finish;
}
/* Check if Tcl is using a different fd for output */
if (fs[m].tcl_handle) {
m = fs[m].tcl_output;
}
if (want_cooked) string = exp_cook(string,&len);
switch (send_style) {
case SEND_STYLE_SLOW:
wc = slow_write(m,string,len,&slow_args);
break;
case SEND_STYLE_HUMAN:
wc = human_write(m,string,&human_args);
break;
case SEND_STYLE_ZERO:
for (;zeros>0;zeros--) wc = write(m,"",1);
/* catching error on last write is sufficient */
break;
default:
wc = exact_write(m,string,len);
break;
}
if (wc < 0) {
exp_error(interp,"write(spawn_id=%d): %s",
m,sys_errlist[errno]);
rc = TCL_ERROR;
goto finish;
}
}
if (send_to_proc) debuglog("}\r\n");
rc = TCL_OK;
finish:
exp_free_i(i);
return rc;
}
void
cmdLogFile_usage(interp)
Tcl_Interp *interp;
{
exp_error(interp,"usage: log_file [[-a] file]");
}
/*ARGSUSED*/
static int
cmdLogFile(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
/* when this function returns, we guarantee that if logfile_all */
/* is TRUE, then logfile is non-zero */
logfile_all = FALSE;
argv++; argc--;
while (argc) {
if (0 != strcmp(*argv,"-a")) break;
argc--;argv++;
logfile_all = TRUE;
}
/* note that logfile_all may be TRUE here, even if logfile is zero */
if (argc > 1) {
/* too many arguments */
cmdLogFile_usage(interp);
if (!logfile) logfile_all = FALSE;
return(TCL_ERROR);
}
if (argc == 0) {
if (logfile_all) {
cmdLogFile_usage(interp);
if (!logfile) logfile_all = FALSE;
return(TCL_ERROR);
} else if (logfile) {
fclose(logfile);
logfile = 0;
/*SUPPRESS 530*/
} else {
/* asked to close file but not open, ignore */
/* exp_error(interp,"log not open"); */
/* return(TCL_ERROR); */
}
} else {
if (logfile) fclose(logfile);
if (*argv[0] == '~') {
argv[0] = Tcl_TildeSubst(interp, argv[0]);
if (argv[0] == NULL) return(TCL_ERROR);
}
if (NULL == (logfile = fopen(argv[0],"a"))) {
exp_error(interp,"%s: %s",argv[0],sys_errlist[errno]);
logfile_all = FALSE;
return(TCL_ERROR);
}
/*new*/ setbuf(logfile,(char *)0);
}
return(TCL_OK);
}
/*ARGSUSED*/
static int
cmdLogUser(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
int old_loguser = loguser;
if (argc == 2) {
if (0 == atoi(argv[1])) loguser = FALSE;
else loguser = TRUE;
}
sprintf(interp->result,"%d",old_loguser);
return(TCL_OK);
}
void
cmdDebug_usage(interp)
Tcl_Interp *interp;
{
exp_error(interp,"usage: debug [-f file] expr");
}
/*ARGSUSED*/
static int
cmdDebug(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
int fopened = FALSE;
argv++;
argc--;
while (argc) {
if (!streq(*argv,"-f")) break;
argc--;argv++;
if (argc < 1) {
cmdDebug_usage(interp);
return(TCL_ERROR);
}
if (debugfile) fclose(debugfile);
if (*argv[0] == '~') {
argv[0] = Tcl_TildeSubst(interp, argv[0]);
if (argv[0] == NULL) return(TCL_ERROR);
}
if (NULL == (debugfile = fopen(*argv,"a"))) {
exp_error(interp,"%s: %s",*argv,sys_errlist[errno]);
return(TCL_ERROR);
}
setbuf(debugfile,(char *)0);
fopened = TRUE;
argc--;argv++;
}
if (argc != 1) {
cmdDebug_usage(interp);
return(TCL_ERROR);
}
/* if no -f given, close file */
if (fopened == FALSE && debugfile) {
fclose(debugfile);
debugfile = 0;
}
exp_is_debugging = atoi(*argv);
return(TCL_OK);
}
/*ARGSUSED*/
static int
cmdExit(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
int value = 0;
if (argc > 2) {
exp_error(interp,"usage: exit [status]");
return(TCL_ERROR);
}
if (argc == 2) {
if (Tcl_GetInt(interp, argv[1], &value) != TCL_OK) {
return TCL_ERROR;
}
}
exp_exit(interp,value);
/*NOTREACHED*/
}
/*ARGSUSED*/
static int
cmdClose(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
int onexec_flag = FALSE; /* true if -onexec seen */
int close_onexec;
int m = -1;
int argc_orig = argc;
char **argv_orig = argv;
argc--; argv++;
for (;argc>0;argc--,argv++) {
if (streq(*argv,"-i")) {
argc--; argv++;
if (*argv) {
exp_error(interp,"usage: -i spawn_id");
return(TCL_ERROR);
}
m = atoi(*argv);
} else if (streq(*argv,"-onexec")) {
argc--; argv++;
if (*argv) {
exp_error(interp,"usage: -onexec 0|1");
return(TCL_ERROR);
}
onexec_flag = TRUE;
close_onexec = atoi(*argv);
} else break;
}
if (argc) {
/* doesn't look like our format, it must be a Tcl-style file */
/* handle. Lucky that formats are easily distinguishable. */
/* Historical note: we used "close" long before there was a */
/* Tcl builtin by the same name. */
/* don't know what is formally correct as 1st arg, but I see */
/* the code doesn't use it anyway */
return(Tcl_CloseCmd(clientData,interp,argc_orig,argv_orig));
}
if (m == -1) {
if (exp_update_master(interp,&m,1,0) == 0) return(TCL_ERROR);
}
if (onexec_flag) {
/* heck, don't even bother to check if fd is open or a real */
/* spawn id, nothing else depends on it */
fcntl(m,F_SETFD,close_onexec);
return TCL_OK;
}
return(exp_close(interp,m));
}
/*ARGSUSED*/
static void
tcl_tracer(clientData,interp,level,command,cmdProc,cmdClientData,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int level;
char *command;
int (*cmdProc)();
ClientData cmdClientData;
int argc;
char *argv[];
{
int i;
/* come out on stderr, by using errorlog */
errorlog("%2d",level);
for (i = 0;i<level;i++) nferrorlog(" ",0/*ignored - satisfy lint*/);
errorlog("%s\r\n",command);
}
/*ARGSUSED*/
static int
cmdTrace(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
static int trace_level = 0;
static Tcl_Trace trace_handle;
if (argc != 2) {
exp_error(interp,"usage: trace level");
return(TCL_ERROR);
}
/* tracing already in effect, undo it */
if (trace_level > 0) Tcl_DeleteTrace(interp,trace_handle);
/* get and save new trace level */
trace_level = atoi(argv[1]);
if (trace_level > 0)
trace_handle = Tcl_CreateTrace(interp,
trace_level,tcl_tracer,(ClientData)0);
return(TCL_OK);
}
static char *wait_usage = "usage: wait [-i spawn_id]";
/*ARGSUSED*/
static int
cmdWait(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
int master;
struct f *f;
/* if your C compiler bombs here, define NO_PID_T in Makefile */
#ifdef NO_PID_T
int pid = 0; /* 0 indicates no error occurred (yet) */
#else
pid_t pid = 0; /* ditto */
#endif
argc--; argv++;
if (argc == 0) {
if (0 == exp_update_master(interp,&master,0,0))
return(TCL_ERROR);
} /* else if (streq(argv,"-pid")) {
argv++;
pid = atoi(argv++);
*/ /* search through fs for one with right pid */ /*
master = pid_to_fd(pid);
} */ else if (streq(argv[0],"-i")) {
if (argc != 2) {
exp_error(interp,wait_usage);
return(TCL_ERROR);
}
master = atoi(argv[1]);
} else {
exp_error(interp,wait_usage);
return(TCL_ERROR);
}
if (!(f = exp_fd2f(interp,master,0,0,"wait"))) return(TCL_ERROR);
/* hmm, user called wait without calling close? */
if (!f->user_closed) exp_close(interp,master);
if (!(f->sys_waited)) {
#if defined(NOWAITPID) && defined(HAVE_WAIT4)
# undef NOWAITPID
# define waitpid(pid,stat,opt) wait4(pid,stat,opt,NULL)
#endif
#ifdef NOWAITPID
int status;
for (;;) {
int i;
pid = wait(&status);
if (pid == f->pid) break;
/* oops, wrong pid */
for (i=0;i<=fd_max;i++) {
if (fs[i].pid == pid) break;
}
if (i>fd_max) {
debuglog("wait found unknown pid %d\r\n",pid);
continue; /* drop on floor */
}
fs[i].sys_waited = TRUE;
fs[i].wait = status;
}
f->wait = status;
#else
pid = waitpid(f->pid,&f->wait,0);
#endif
f->sys_waited = TRUE;
}
exp_destroy(master);
#ifndef WEXITSTATUS
#define WEXITSTATUS(x) x
#endif
/* return {pid status} or {-1 errno} */
/* non-portable assumption that pid_t can be printed with %d */
sprintf(interp->result,"%d %d",f->pid,
(pid == -1)?errno:WEXITSTATUS(f->wait));
return(TCL_OK);
}
/*ARGSUSED*/
static int
cmdFork(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
int pid;
if (argc > 1) {
exp_error(interp,"usage: fork");
return(TCL_ERROR);
}
if (0 == (pid = fork())) exp_forked = TRUE;
sprintf(interp->result,"%d",pid);
debuglog("fork: returns {%s}\r\n",interp->result);
return(TCL_OK);
}
/*ARGSUSED*/
static int
cmdDisconnect(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
/* tell Saber to ignore non-use of ttyfd */
/*SUPPRESS 591*/
int ttyfd;
if (argc > 1) {
exp_error(interp,"usage: disconnect");
return(TCL_ERROR);
}
if (exp_disconnected) {
exp_error(interp,"already disconnected");
return(TCL_ERROR);
}
if (!exp_forked) {
exp_error(interp,"can only disconnect child process");
return(TCL_ERROR);
}
exp_disconnected = TRUE;
/* ignore hangup signals generated by testing ptys in getptymaster */
/* and other places */
signal(SIGHUP,SIG_IGN);
/* reopen prevents confusion between send/expect_user */
/* accidentally mapping to a real spawned process after a disconnect */
exp_close(interp,0); open("/dev/null",0); fd_new(0, EXP_NOPID);
exp_close(interp,1); open("/dev/null",1); fd_new(1, EXP_NOPID);
/* reopen stderr saves error checking in error/log routines. */
exp_close(interp,2); open("/dev/null",1); fd_new(2, EXP_NOPID);
Tcl_UnsetVar(interp,"tty_spawn_id",TCL_GLOBAL_ONLY);
#ifdef DO_SETSID
setsid();
#else
#ifdef SYSV3
/* put process in our own pgrp, and lose controlling terminal */
#ifdef sysV88
/* With setpgrp first, child ends up with closed stdio */
/* according to Dave Schmitt <daves@techmpc.csg.gss.mot.com> */
if (fork()) exit(0);
setpgrp();
#else
setpgrp();
/*signal(SIGHUP,SIG_IGN); moved out to above */
if (fork()) exit(0); /* first child exits (as per Stevens, */
/* UNIX Network Programming, p. 79-80) */
/* second child process continues as daemon */
#endif
#else /* !SYSV3 */
#ifdef MIPS_BSD
/* required on BSD side of MIPS OS <jmsellen@watdragon.waterloo.edu> */
# include <sysv/sys.s>
syscall(SYS_setpgrp);
#endif
setpgrp(0,0);
/* setpgrp(0,getpid());*/ /* put process in our own pgrp */
ttyfd = open("/dev/tty", O_RDWR);
if (ttyfd >= 0) {
/* zap controlling terminal if we had one */
(void) ioctl(ttyfd, TIOCNOTTY, (char *)0);
(void) close(ttyfd);
}
#endif /* SYSV3 */
#endif /* DO_SETSID */
return(TCL_OK);
}
/*ARGSUSED*/
static int
cmdOverlay(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
int newfd, oldfd;
int dash_name = 0;
char *command;
argc--; argv++;
while (argc) {
if (*argv[0] != '-') break; /* not a flag */
if (streq(*argv,"-")) { /* - by itself */
argc--; argv++;
dash_name = 1;
continue;
}
newfd = atoi(argv[0]+1);
argc--; argv++;
if (argc == 0) {
exp_error(interp,"overlay -# requires additional argument");
return(TCL_ERROR);
}
oldfd = atoi(argv[0]);
argc--; argv++;
debuglog("overlay: mapping fd %d to %d\r\n",oldfd,newfd);
if (oldfd != newfd) (void) dup2(oldfd,newfd);
else debuglog("warning: overlay: old fd == new fd (%d)\r\n",oldfd);
}
if (argc == 0) {
exp_error(interp,"need program name");
return(TCL_ERROR);
}
command = argv[0];
if (dash_name) {
argv[0] = ckalloc(1+strlen(command));
sprintf(argv[0],"-%s",command);
}
signal(SIGINT, SIG_DFL);
signal(SIGQUIT, SIG_DFL);
(void) execvp(command,argv);
exp_error(interp,"execvp(%s): %s\r\n",argv[0],sys_errlist[errno]);
return(TCL_ERROR);
}
#if 0
/*ARGSUSED*/
int
cmdReady(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
char num[4]; /* can hold up to "999 " */
char buf[1024]; /* can easily hold 256 spawn_ids! */
int i, j;
int *masters, *masters2;
int timeout = get_timeout();
if (argc < 2) {
exp_error(interp,"usage: ready spawn_id1 [spawn_id2 ...]");
return(TCL_ERROR);
}
masters = (int *)ckalloc((argc-1)*sizeof(int));
masters2 = (int *)ckalloc((argc-1)*sizeof(int));
for (i=1;i<argc;i++) {
j = atoi(argv[i]);
if (!exp_fd2f(interp,j,1,"ready")) {
free(masters);
return(TCL_ERROR);
}
masters[i-1] = j;
}
j = i-1;
if (TCL_ERROR == ready(masters,i-1,masters2,&j,&timeout))
return(TCL_ERROR);
/* pack result back into out-array */
buf[0] = '\0';
for (i=0;i<j;i++) {
sprintf(num,"%d ",masters2[i]); /* note extra blank */
strcat(buf,num);
}
free(masters); free(masters2);
Tcl_Return(interp,buf,TCL_VOLATILE);
return(TCL_OK);
}
#endif
/*ARGSUSED*/
int
cmdInterpreter(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
if (argc != 1) {
exp_error(interp,"no arguments allowed");
return(TCL_ERROR);
}
exp_interpreter(interp);
/* errors and ok, are caught by escape() and discarded */
/* the only thing that actually comes out of escape are */
/* RETURN, BREAK, and CONTINUE which we all translate to OK */
return(TCL_OK);
}
/* this command supercede's Tcl's builtin CONTINUE command */
/*ARGSUSED*/
int
cmdContinueExpect(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
if (argc == 1) return(TCL_CONTINUE);
else if (argc == 2) {
if (streq(argv[1],"-expect")) {
return(TCL_CONTINUE_EXPECT);
}
}
exp_error(interp,"usage: continue [-expect]\n");
return(TCL_ERROR);
}
/* this command supercede's Tcl's builtin RETURN command */
/*ARGSUSED*/
int
cmdReturnInter(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
int rc = TCL_RETURN;
if (argc == 1) return(TCL_RETURN);
argc--; argv++;
if (argc && streq(*argv,"-tcl")) {
rc = TCL_RETURN_TCL;
argc--; argv++;
}
if (argc) {
Tcl_SetResult(interp,*argv,TCL_VOLATILE);
argc--; argv++;
}
if (argc) {
exp_error(interp,"usage: too many args\n");
return(TCL_ERROR);
}
return(rc);
}
void
exp_create_commands(interp)
Tcl_Interp *interp;
{
extern int cmdInteract();
extern int cmdExpectVersion();
extern int cmdPrompt1();
extern int cmdPrompt2();
Tcl_CreateCommand(interp,"close",
cmdClose,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_close",
cmdClose,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"debug",
cmdDebug,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_debug",
cmdDebug,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"disconnect",
cmdDisconnect,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_disconnect",
cmdDisconnect,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exit",
cmdExit,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_exit",
cmdExit,(ClientData)0,exp_deleteProc);
/* following commands are created in exp_init_expect in expect.c */
/* to prevent unnecessary name space pollution by the ClientData */
/* argument to Tcl_CreateCommand */
/* expect, expect_after, expect_before, expect_user */
/* trap */
/* matchmax */
Tcl_CreateCommand(interp,"continue",
cmdContinueExpect,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_continue",
cmdContinueExpect,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"expect_version",
cmdExpectVersion,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"fork",
cmdFork,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_fork",
cmdFork,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"pid",
cmdGetpid,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_pid",
cmdExpPid,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"getpid",
cmdGetpid,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"interact",
cmdInteract,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"interpreter",
cmdInterpreter,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_interpreter",
cmdInterpreter,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"log_file",
cmdLogFile,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_log_file",
cmdLogFile,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"log_user",
cmdLogUser,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_log_user",
cmdLogUser,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"overlay",
cmdOverlay,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_overlay",
cmdOverlay,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"prompt1",
cmdPrompt1,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_prompt1",
cmdPrompt1,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"prompt2",
cmdPrompt2,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_prompt2",
cmdPrompt2,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"return",
cmdReturnInter,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_return",
cmdReturnInter,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"send",
cmdSend,(ClientData)&sendCD_proc,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_send",
cmdSend,(ClientData)&sendCD_proc,exp_deleteProc);
/* Tk may wipe out "send" so provide an alias: "send_spawn" */
Tcl_CreateCommand(interp,"exp_send_spawn",
cmdSend,(ClientData)&sendCD_proc,exp_deleteProc);
Tcl_CreateCommand(interp,"send_error",
cmdSend,(ClientData)&sendCD_error,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_send_error",
cmdSend,(ClientData)&sendCD_error,exp_deleteProc);
Tcl_CreateCommand(interp,"send_log",
cmdSendLog,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_send_log",
cmdSendLog,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"send_tty",
cmdSend,(ClientData)&sendCD_tty,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_send_tty",
cmdSend,(ClientData)&sendCD_tty,exp_deleteProc);
Tcl_CreateCommand(interp,"send_user",
cmdSend,(ClientData)&sendCD_user,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_send_user",
cmdSend,(ClientData)&sendCD_user,exp_deleteProc);
Tcl_CreateCommand(interp,"spawn",
cmdSpawn,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"strace",
cmdTrace,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_strace",
cmdTrace,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"system",
cmdSystem,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_system",
cmdSystem,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"wait",
cmdWait,(ClientData)0,exp_deleteProc);
Tcl_CreateCommand(interp,"exp_wait",
cmdWait,(ClientData)0,exp_deleteProc);
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.