expect/exp_event.c

   1 /* exp_event.c - event interface for Expect
   2
   3 Written by: Don Libes, NIST, 2/6/90
   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 /* Notes:
  12 I'm only a little worried because Tk does not check for errno == EBADF
  13 after calling select.  I imagine that if the user passes in a bad file
  14 descriptor, we'll never get called back, and thus, we'll hang forever
  15 - it would be better to at least issue a diagnostic to the user.
  16
  17 Another possible problem: Tk does not do file callbacks round-robin.
  18
  19 Another possible problem: Calling Create/DeleteFileHandler
  20 before/after every Tcl_Eval... in expect/interact could be very
  21 expensive.
  22
  23 */
  24
  25
  26 #include "expect_cf.h"
  27 #include <stdio.h>
  28 #include <errno.h>
  29 #include <sys/types.h>
  30 #include <sys/time.h>
  31
  32 #ifdef HAVE_SYS_WAIT_H
  33 #include <sys/wait.h>
  34 #endif
  35
  36 #ifdef HAVE_PTYTRAP
  37 #  include <sys/ptyio.h>
  38 #endif
  39
  40 #include "tcl.h"
  41 #include "exp_prog.h"
  42 #include "exp_command.h"        /* for struct exp_f defs */
  43 #include "exp_event.h"
  44
  45 /* Tcl_DoOneEvent will call our filehandler which will set the following */
  46 /* vars enabling us to know where and what kind of I/O we can do */
  47 /*#define EXP_SPAWN_ID_BAD      -1*/
  48 /*#define EXP_SPAWN_ID_TIMEOUT  -2*/    /* really indicates a timeout */
  49
  50 static int ready_fd = EXP_SPAWN_ID_BAD;
  51 static int ready_mask;
  52 static int default_mask = TCL_READABLE | TCL_EXCEPTION;
  53
  54
  55 void
  56 exp_event_disarm(fd)
  57 int fd;
  58 {
  59 #if TCL_MAJOR_VERSION < 8
  60         Tcl_DeleteFileHandler(exp_fs[fd].Master);
  61 #else
  62         Tcl_DeleteFileHandler(fd);
  63 #endif
  64
  65         /* remember that filehandler has been disabled so that */
  66         /* it can be turned on for fg expect's as well as bg */
  67         exp_fs[fd].fg_armed = FALSE;
  68 }
  69
  70 void
  71 exp_event_disarm_fast(fd,filehandler)
  72 int fd;
  73 Tcl_FileProc *filehandler;
  74 {
  75         /* Temporarily delete the filehandler by assigning it a mask */
  76         /* that permits no events! */
  77         /* This reduces the calls to malloc/free inside Tcl_...FileHandler */
  78         /* Tk insists on having a valid proc here even though it isn't used */
  79 #if TCL_MAJOR_VERSION < 8
  80         Tcl_CreateFileHandler(exp_fs[fd].Master,0,filehandler,(ClientData)0);
  81 #else
  82         Tcl_CreateFileHandler(fd,0,filehandler,(ClientData)0);
  83 #endif
  84
  85         /* remember that filehandler has been disabled so that */
  86         /* it can be turned on for fg expect's as well as bg */
  87         exp_fs[fd].fg_armed = FALSE;
  88 }
  89
  90 static void
  91 exp_arm_background_filehandler_force(m)
  92 int m;
  93 {
  94 #if TCL_MAJOR_VERSION < 8
  95         Tcl_CreateFileHandler(exp_fs[m].Master,
  96 #else
  97         Tcl_CreateFileHandler(m,
  98 #endif
  99                 TCL_READABLE|TCL_EXCEPTION,
 100                 exp_background_filehandler,
 101                 (ClientData)(exp_fs[m].fd_ptr));
 102
 103         exp_fs[m].bg_status = armed;
 104 }
 105
 106 void
 107 exp_arm_background_filehandler(m)
 108 int m;
 109 {
 110         switch (exp_fs[m].bg_status) {
 111         case unarmed:
 112                 exp_arm_background_filehandler_force(m);
 113                 break;
 114         case disarm_req_while_blocked:
 115                 exp_fs[m].bg_status = blocked;  /* forget request */
 116                 break;
 117         case armed:
 118         case blocked:
 119                 /* do nothing */
 120                 break;
 121         }
 122 }
 123
 124 void
 125 exp_disarm_background_filehandler(m)
 126 int m;
 127 {
 128         switch (exp_fs[m].bg_status) {
 129         case blocked:
 130                 exp_fs[m].bg_status = disarm_req_while_blocked;
 131                 break;
 132         case armed:
 133                 exp_fs[m].bg_status = unarmed;
 134                 exp_event_disarm(m);
 135                 break;
 136         case disarm_req_while_blocked:
 137         case unarmed:
 138                 /* do nothing */
 139                 break;
 140         }
 141 }
 142
 143 /* ignore block status and forcibly disarm handler - called from exp_close. */
 144 /* After exp_close returns, we will not have an opportunity to disarm */
 145 /* because the fd will be invalid, so we force it here. */
 146 void
 147 exp_disarm_background_filehandler_force(m)
 148 int m;
 149 {
 150         switch (exp_fs[m].bg_status) {
 151         case blocked:
 152         case disarm_req_while_blocked:
 153         case armed:
 154                 exp_fs[m].bg_status = unarmed;
 155                 exp_event_disarm(m);
 156                 break;
 157         case unarmed:
 158                 /* do nothing */
 159                 break;
 160         }
 161 }
 162
 163 /* this can only be called at the end of the bg handler in which */
 164 /* case we know the status is some kind of "blocked" */
 165 void
 166 exp_unblock_background_filehandler(m)
 167 int m;
 168 {
 169         switch (exp_fs[m].bg_status) {
 170         case blocked:
 171                 exp_arm_background_filehandler_force(m);
 172                 break;
 173         case disarm_req_while_blocked:
 174                 exp_disarm_background_filehandler_force(m);
 175                 break;
 176         case armed:
 177         case unarmed:
 178                 /* Not handled, FIXME? */
 179                 break;
 180         }
 181 }
 182
 183 /* this can only be called at the beginning of the bg handler in which */
 184 /* case we know the status must be "armed" */
 185 void
 186 exp_block_background_filehandler(m)
 187 int m;
 188 {
 189         exp_fs[m].bg_status = blocked;
 190         exp_event_disarm_fast(m,exp_background_filehandler);
 191 }
 192
 193
 194 /*ARGSUSED*/
 195 static void
 196 exp_timehandler(clientData)
 197 ClientData clientData;
 198 {
 199         *(int *)clientData = TRUE;
 200 }
 201
 202 static void exp_filehandler(clientData,mask)
 203 ClientData clientData;
 204 int mask;
 205 {
 206         /* if input appears, record the fd on which it appeared */
 207
 208         ready_fd = *(int *)clientData;
 209         ready_mask = mask;
 210         exp_event_disarm_fast(ready_fd,exp_filehandler);
 211
 212 #if 0
 213         if (ready_fd == *(int *)clientData) {
 214                 /* if input appears from an fd which we've already heard */
 215                 /* forcibly tell it to shut up.  We could also shut up */
 216                 /* every instance, but it is more efficient to leave the */
 217                 /* fd enabled with the belief that we may rearm soon enough */
 218                 /* anyway. */
 219
 220                 exp_event_disarm_fast(ready_fd,exp_filehandler);
 221         } else {
 222                 ready_fd = *(int *)clientData;
 223                 ready_mask = mask;
 224         }
 225 #endif
 226 }
 227
 228 /* returns status, one of EOF, TIMEOUT, ERROR or DATA */
 229 /* can now return RECONFIGURE, too */
 230 /*ARGSUSED*/
 231 int exp_get_next_event(interp,masters, n,master_out,timeout,key)
 232 Tcl_Interp *interp;
 233 int *masters;
 234 int n;                  /* # of masters */
 235 int *master_out;        /* 1st ready master, not set if none */
 236 int timeout;            /* seconds */
 237 int key;
 238 {
 239         static rr = 0;  /* round robin ptr */
 240         int i;  /* index into in-array */
 241 #ifdef HAVE_PTYTRAP
 242         struct request_info ioctl_info;
 243 #endif
 244
 245         int old_configure_count = exp_configure_count;
 246
 247         int timer_created = FALSE;
 248         int timer_fired = FALSE;
 249         Tcl_TimerToken timetoken;/* handle to Tcl timehandler descriptor */
 250
 251         for (;;) {
 252                 int m;
 253                 struct exp_f *f;
 254
 255                 /* if anything has been touched by someone else, report that */
 256                 /* an event has been received */
 257
 258                 for (i=0;i<n;i++) {
 259                         rr++;
 260                         if (rr >= n) rr = 0;
 261
 262                         m = masters[rr];
 263                         f = exp_fs + m;
 264
 265                         if (f->key != key) {
 266                                 f->key = key;
 267                                 f->force_read = FALSE;
 268                                 *master_out = m;
 269                                 return(EXP_DATA_OLD);
 270                         } else if ((!f->force_read) && (f->size != 0)) {
 271                                 *master_out = m;
 272                                 return(EXP_DATA_OLD);
 273                         }
 274                 }
 275
 276                 if (!timer_created) {
 277                         if (timeout >= 0) {
 278                                 timetoken = Tcl_CreateTimerHandler(1000*timeout,
 279                                                 exp_timehandler,
 280                                                 (ClientData)&timer_fired);
 281                                 timer_created = TRUE;
 282                         }
 283                 }
 284
 285                 for (;;) {
 286                         int j;
 287
 288                         /* make sure that all fds that should be armed are */
 289                         for (j=0;j<n;j++) {
 290                                 int k = masters[j];
 291
 292                                 if (!exp_fs[k].fg_armed) {
 293                                         Tcl_CreateFileHandler(
 294 #if TCL_MAJOR_VERSION < 8
 295                                              exp_fs[k].Master,
 296 #else
 297                                              k,
 298 #endif
 299                                              default_mask,
 300                                              exp_filehandler,
 301                                              (ClientData)exp_fs[k].fd_ptr);
 302                                         exp_fs[k].fg_armed = TRUE;
 303                                 }
 304                         }
 305
 306                         Tcl_DoOneEvent(0);      /* do any event */
 307
 308                         if (timer_fired) return(EXP_TIMEOUT);
 309
 310                         if (old_configure_count != exp_configure_count) {
 311                                 if (timer_created) Tcl_DeleteTimerHandler(timetoken);
 312                                 return EXP_RECONFIGURE;
 313                         }
 314
 315                         if (ready_fd == EXP_SPAWN_ID_BAD) continue;
 316
 317                         /* if it was from something we're not looking for at */
 318                         /* the moment, ignore it */
 319                         for (j=0;j<n;j++) {
 320                                 if (ready_fd == masters[j]) goto found;
 321                         }
 322
 323                         /* not found */
 324                         exp_event_disarm_fast(ready_fd,exp_filehandler);
 325                         ready_fd = EXP_SPAWN_ID_BAD;
 326                         continue;
 327                 found:
 328                         *master_out = ready_fd;
 329                         ready_fd = EXP_SPAWN_ID_BAD;
 330
 331                         /* this test should be redundant but SunOS */
 332                         /* raises both READABLE and EXCEPTION (for no */
 333                         /* apparent reason) when selecting on a plain file */
 334                         if (ready_mask & TCL_READABLE) {
 335                                 if (timer_created) Tcl_DeleteTimerHandler(timetoken);
 336                                 return EXP_DATA_NEW;
 337                         }
 338
 339                         /* ready_mask must contain TCL_EXCEPTION */
 340 #ifndef HAVE_PTYTRAP
 341                         if (timer_created) Tcl_DeleteTimerHandler(timetoken);
 342                         return(EXP_EOF);
 343 #else
 344                         if (ioctl(*master_out,TIOCREQCHECK,&ioctl_info) < 0) {
 345                                 if (timer_created)
 346                                         Tcl_DeleteTimerHandler(timetoken);
 347                                 exp_debuglog("ioctl error on TIOCREQCHECK: %s", Tcl_PosixError(interp));
 348                                 return(EXP_TCLERROR);
 349                         }
 350                         if (ioctl_info.request == TIOCCLOSE) {
 351                                 if (timer_created)
 352                                         Tcl_DeleteTimerHandler(timetoken);
 353                                 return(EXP_EOF);
 354                         }
 355                         if (ioctl(*master_out, TIOCREQSET, &ioctl_info) < 0) {
 356                                 exp_debuglog("ioctl error on TIOCREQSET after ioctl or open on slave: %s", Tcl_ErrnoMsg(errno));
 357                         }
 358                         /* presumably, we trapped an open here */
 359                         continue;
 360 #endif /* !HAVE_PTYTRAP */
 361                 }
 362         }
 363 }
 364
 365 /* Having been told there was an event for a specific fd, get it */
 366 /* returns status, one of EOF, TIMEOUT, ERROR or DATA */
 367 /*ARGSUSED*/
 368 int
 369 exp_get_next_event_info(interp,fd,ready_mask)
 370 Tcl_Interp *interp;
 371 int fd;
 372 int ready_mask;
 373 {
 374 #ifdef HAVE_PTYTRAP
 375         struct request_info ioctl_info;
 376 #endif
 377
 378         if (ready_mask & TCL_READABLE) return EXP_DATA_NEW;
 379
 380         /* ready_mask must contain TCL_EXCEPTION */
 381
 382 #ifndef HAVE_PTYTRAP
 383         return(EXP_EOF);
 384 #else
 385         if (ioctl(fd,TIOCREQCHECK,&ioctl_info) < 0) {
 386                 exp_debuglog("ioctl error on TIOCREQCHECK: %s",
 387                                 Tcl_PosixError(interp));
 388                 return(EXP_TCLERROR);
 389         }
 390         if (ioctl_info.request == TIOCCLOSE) {
 391                 return(EXP_EOF);
 392         }
 393         if (ioctl(fd, TIOCREQSET, &ioctl_info) < 0) {
 394                 exp_debuglog("ioctl error on TIOCREQSET after ioctl or open on slave: %s", Tcl_ErrnoMsg(errno));
 395         }
 396         /* presumably, we trapped an open here */
 397         /* call it an error for lack of anything more descriptive */
 398         /* it will be thrown away by caller anyway */
 399         return EXP_TCLERROR;
 400 #endif
 401 }
 402
 403 /*ARGSUSED*/
 404 int     /* returns TCL_XXX */
 405 exp_dsleep(interp,sec)
 406 Tcl_Interp *interp;
 407 double sec;
 408 {
 409         int timer_fired = FALSE;
 410
 411         Tcl_CreateTimerHandler((int)(sec*1000),exp_timehandler,(ClientData)&timer_fired);
 412
 413         while (1) {
 414                 Tcl_DoOneEvent(0);
 415                 if (timer_fired) return TCL_OK;
 416
 417                 if (ready_fd == EXP_SPAWN_ID_BAD) continue;
 418
 419                 exp_event_disarm_fast(ready_fd,exp_filehandler);
 420                 ready_fd = EXP_SPAWN_ID_BAD;
 421         }
 422 }
 423
 424 #if 0
 425 /*ARGSUSED*/
 426 int     /* returns TCL_XXX */
 427 exp_usleep(interp,usec)
 428 Tcl_Interp *interp;
 429 long usec;
 430 {
 431         int timer_fired = FALSE;
 432
 433         Tcl_CreateTimerHandler(usec/1000,exp_timehandler,(ClientData)&timer_fired);
 434
 435         while (1) {
 436                 Tcl_DoOneEvent(0);
 437                 if (timer_fired) return TCL_OK;
 438
 439                 if (ready_fd == EXP_SPAWN_ID_BAD) continue;
 440
 441                 exp_event_disarm_fast(ready_fd,exp_filehandler);
 442                 ready_fd = EXP_SPAWN_ID_BAD;
 443         }
 444 }
 445 #endif
 446
 447 static char destroy_cmd[] = "destroy .";
 448
 449 static void
 450 exp_event_exit_real(interp)
 451 Tcl_Interp *interp;
 452 {
 453         Tcl_Eval(interp,destroy_cmd);
 454 }
 455
 456 /* set things up for later calls to event handler */
 457 void
 458 exp_init_event()
 459 {
 460         exp_event_exit = exp_event_exit_real;
 461 }
 462
 463 #ifdef __CYGWIN32__
 464 #if 0
 465
 466 /* The Tcl_CreateFileHandler call is only defined on Unix.  We provide
 467    our own implementation here that works on cygwin32.  */
 468
 469 #include <windows.h>
 470 #include <sys/socket.h>
 471 #include <tclInt.h>
 472
 473 #if TCL_MAJOR_VERSION < 7
 474 # error not implemented
 475 #endif
 476
 477 static void pipe_setup _ANSI_ARGS_((ClientData, int));
 478 static void pipe_check _ANSI_ARGS_((ClientData, int));
 479 static void pipe_exit _ANSI_ARGS_((ClientData));
 480 static int pipe_close _ANSI_ARGS_((ClientData, Tcl_Interp *));
 481 static int pipe_input _ANSI_ARGS_((ClientData, char *, int, int *));
 482 static int pipe_output _ANSI_ARGS_((ClientData, char *, int, int *));
 483 static void pipe_watch _ANSI_ARGS_((ClientData, int));
 484 static int pipe_get_handle _ANSI_ARGS_((ClientData, int, ClientData *));
 485 static int pipe_event _ANSI_ARGS_((Tcl_Event *, int));
 486
 487 /* The pipe channel interface.  */
 488
 489 static Tcl_ChannelType pipe_channel = {
 490     "expect_pipe",
 491     NULL, /* block */
 492     pipe_close,
 493     pipe_input,
 494     pipe_output,
 495     NULL, /* seek */
 496     NULL, /* set option */
 497     NULL, /* get option */
 498     pipe_watch,
 499     pipe_get_handle
 500 };
 501
 502 /* The structure we use to represent a pipe channel.  */
 503
 504 struct pipe_info {
 505     struct pipe_info *next;     /* Next pipe.  */
 506     Tcl_Channel channel;        /* The Tcl channel.  */
 507     int fd;                     /* cygwin32 file descriptor.  */
 508     int watch_mask;             /* Events that should be reported.  */
 509     int flags;                  /* State flags; see below.  */
 510     HANDLE flags_mutex;         /* Mutex to control access to flags.  */
 511     HANDLE mutex;               /* Mutex to control access to pipe.  */
 512     HANDLE try_read;            /* Event to tell thread to try a read.  */
 513     HANDLE pthread;             /* Handle of thread inspecting the pipe. */
 514 };
 515
 516 /* Values that can appear in the flags field of a pipe_info structure.  */
 517
 518 #define PIPE_PENDING    (1 << 0)        /* Message pending.  */
 519 #define PIPE_READABLE   (1 << 1)        /* Pipe is readable.  */
 520 #define PIPE_CLOSED     (1 << 2)        /* Pipe is closed.  */
 521 #define PIPE_HAS_THREAD (1 << 3)        /* A thread is running.  */
 522
 523 /* A pipe event structure.  */
 524
 525 struct pipe_event {
 526     Tcl_Event header;           /* Standard Tcl event header.  */
 527     struct pipe_info *pipe;     /* Pipe information.  */
 528 };
 529
 530 /* Whether we've initialized the pipe code.  */
 531
 532 static int pipe_initialized;
 533
 534 /* The list of pipes.  */
 535
 536 static struct pipe_info *pipes;
 537
 538 /* A hidden window we use for pipe events.  */
 539
 540 static HWND pipe_window;
 541
 542 /* A message we use for pipe events.  */
 543
 544 #define PIPE_MESSAGE (WM_USER + 1)
 545
 546 /* Get the flags for a pipe.  */
 547
 548 static int
 549 pipe_get_flags (pipe)
 550 struct pipe_info *pipe;
 551 {
 552         int flags;
 553
 554         WaitForSingleObject (pipe->flags_mutex, INFINITE);
 555         flags = pipe->flags;
 556         ReleaseMutex (pipe->flags_mutex);
 557         return flags;
 558 }
 559
 560 /* Set a flag for a pipe.  */
 561
 562 static void
 563 pipe_set_flag (pipe, flag)
 564 struct pipe_info *pipe;
 565 int flag;
 566 {
 567         WaitForSingleObject (pipe->flags_mutex, INFINITE);
 568         pipe->flags |= flag;
 569         ReleaseMutex (pipe->flags_mutex);
 570 }
 571
 572 /* Reset a flag for a pipe.  */
 573
 574 static void
 575 pipe_reset_flag (pipe, flag)
 576 struct pipe_info *pipe;
 577 int flag;
 578 {
 579         WaitForSingleObject (pipe->flags_mutex, INFINITE);
 580         pipe->flags &= ~ flag;
 581         ReleaseMutex (pipe->flags_mutex);
 582 }
 583
 584 /* This function runs in a separate thread.  When requested, it sends
 585    a message if there is something to read from the pipe.  FIXME: I'm
 586    not sure that this thread will ever be killed off at present.  */
 587
 588 static DWORD
 589 pipe_thread (arg)
 590 LPVOID arg;
 591 {
 592         struct pipe_info *pipe = (struct pipe_info *) arg;
 593         HANDLE handle = get_osfhandle(pipe->fd);
 594         struct timeval timeout;
 595
 596         while (1) {
 597                 int n, tba;
 598                 fd_set r, x;
 599
 600                 /* time out in case this thread was "forgotten" */
 601                 if (WaitForSingleObject (pipe->try_read, 10000) == WAIT_TIMEOUT)
 602                   {
 603                     n = PeekNamedPipe(handle, NULL, 0, NULL, &tba, NULL);
 604                     if (n == 0)
 605                       break; /* pipe closed? */
 606                   }
 607
 608                 if (pipe_get_flags (pipe) & PIPE_CLOSED) {
 609                         break;
 610                 }
 611
 612                 /* We use a loop periodically trying PeekNamedPipe.
 613                    This is inefficient, but unfortunately Windows
 614                    doesn't have any asynchronous mechanism to read
 615                    from a pipe.  */
 616
 617                 timeout.tv_sec = 10;
 618                 timeout.tv_usec = 0;
 619                 FD_ZERO (&r);
 620                 FD_SET (pipe->fd, &r);
 621                 FD_ZERO (&x);
 622                 FD_SET (pipe->fd, &x);
 623                 if ((n = select (pipe->fd + 1, &r, NULL, &x, &timeout)) <= 0 ||
 624                     FD_ISSET(pipe->fd, &x))
 625                   /* pipe_set_flag (pipe, PIPE_CLOSED)*/;
 626
 627                 /* Something can be read from the pipe.  */
 628                 pipe_set_flag (pipe, PIPE_READABLE);
 629
 630                 if (pipe_get_flags (pipe) & PIPE_CLOSED) {
 631                         break;
 632                 }
 633
 634                 /* Post a message to wake up the event loop.  */
 635                 PostMessage (pipe_window, PIPE_MESSAGE, 0, (LPARAM) pipe);
 636                 if (n < 0 || FD_ISSET (pipe->fd, &x))
 637                         break;
 638         }
 639
 640         /* The pipe is closed.  */
 641
 642         CloseHandle (pipe->flags_mutex); pipe->flags_mutex = NULL;
 643         CloseHandle (pipe->try_read); pipe->try_read = NULL;
 644         pipe_reset_flag (pipe, PIPE_HAS_THREAD);
 645         return 0;
 646 }
 647
 648 /* This function is called when pipe_thread posts a message.  */
 649
 650 static LRESULT CALLBACK
 651 pipe_proc (hwnd, message, wParam, lParam)
 652 HWND hwnd;
 653 UINT message;
 654 WPARAM wParam;
 655 LPARAM lParam;
 656 {
 657         if (message != PIPE_MESSAGE) {
 658                 return DefWindowProc (hwnd, message, wParam, lParam);
 659         }
 660
 661         /* This function really only exists to wake up the main Tcl
 662            event loop.  We don't actually have to do anything.  */
 663
 664         return 0;
 665 }
 666
 667 /* Initialize the pipe channel.  */
 668
 669 static void
 670 pipe_init ()
 671 {
 672         WNDCLASS class;
 673
 674         pipe_initialized = 1;
 675
 676         Tcl_CreateEventSource (pipe_setup, pipe_check, NULL);
 677         Tcl_CreateExitHandler (pipe_exit, NULL);
 678
 679         /* Create a hidden window for asynchronous notification.  */
 680
 681         memset (&class, 0, sizeof class);
 682         class.hInstance = GetModuleHandle (NULL);
 683         class.lpszClassName = "expect_pipe";
 684         class.lpfnWndProc = pipe_proc;
 685
 686         if (! RegisterClass (&class)) {
 687                 exp_errorlog ("RegisterClass failed: %d\n", GetLastError ());
 688                 exit (-1);
 689         }
 690
 691         pipe_window = CreateWindow ("expect_pipe", "expect_pipe",
 692                                     WS_TILED, 0, 0, 0, 0, NULL, NULL,
 693                                     class.hInstance, NULL);
 694         if (pipe_window == NULL) {
 695                 exp_errorlog ("CreateWindow failed: %d\n", GetLastError ());
 696                 exit (-1);
 697         }
 698 }
 699
 700 /* Clean up the pipe channel when we exit.  */
 701
 702 static void
 703 pipe_exit (cd)
 704 ClientData cd;
 705 {
 706         Tcl_DeleteEventSource (pipe_setup, pipe_check, NULL);
 707         UnregisterClass ("expect_pipe", GetModuleHandle (NULL));
 708         DestroyWindow (pipe_window);
 709         pipe_initialized = 0;
 710 }
 711
 712 /* Set up for a pipe event.  */
 713
 714 static void
 715 pipe_setup (cd, flags)
 716 ClientData cd;
 717 int flags;
 718 {
 719         struct pipe_info *p;
 720         Tcl_Time zero_time = { 0, 0 };
 721
 722         if (! (flags & TCL_FILE_EVENTS)) {
 723                 return;
 724         }
 725
 726         /* See if there is a watched pipe for which we already have an
 727            event.  If there is, set the maximum block time to 0.  */
 728
 729         for (p = pipes; p != NULL; p = p->next) {
 730                 if ((p->watch_mask &~ TCL_READABLE)
 731                     || ((p->watch_mask & TCL_READABLE)
 732                         && ((pipe_get_flags (p) & PIPE_HAS_THREAD) == 0
 733                             || (pipe_get_flags (p) & PIPE_READABLE)))) {
 734                         Tcl_SetMaxBlockTime (&zero_time);
 735                         break;
 736                 } else if (p->watch_mask & TCL_READABLE) {
 737                         /* Tell the thread to try reads and let us
 738                            know when it is done.  */
 739                         SetEvent (p->try_read);
 740                 }
 741         }
 742 }
 743
 744 /* Check pipes for events.  */
 745
 746 static void
 747 pipe_check (cd, flags)
 748 ClientData cd;
 749 int flags;
 750 {
 751         struct pipe_info *p;
 752
 753         if (! (flags & TCL_FILE_EVENTS)) {
 754                 return;
 755         }
 756
 757         /* Queue events for any watched pipes that don't already have
 758            events queued.  */
 759
 760         for (p = pipes; p != NULL; p = p->next) {
 761                 if (((p->watch_mask &~ TCL_READABLE)
 762                      || ((p->watch_mask & TCL_READABLE)
 763                          && ((pipe_get_flags (p) & PIPE_HAS_THREAD) == 0
 764                              || (pipe_get_flags (p) & PIPE_READABLE))))
 765                     && ! (pipe_get_flags (p) & PIPE_PENDING)) {
 766                         struct pipe_event *ev;
 767
 768                         pipe_set_flag (p, PIPE_PENDING);
 769                         ev = (struct pipe_event *) Tcl_Alloc (sizeof *ev);
 770                         ev->header.proc = pipe_event;
 771                         ev->pipe = p;
 772                         Tcl_QueueEvent ((Tcl_Event *) ev, TCL_QUEUE_TAIL);
 773                 }
 774         }
 775 }
 776
 777 /* Handle closing a pipe.  This is probably never called at present.  */
 778
 779 static int
 780 pipe_close (cd, interp)
 781 ClientData cd;
 782 Tcl_Interp *interp;
 783 {
 784         struct pipe_info *p = (struct pipe_info *) cd;
 785         struct pipe_info **pp;
 786
 787         for (pp = &pipes; *pp != NULL; pp = &(*pp)->next) {
 788                 if (*pp == p) {
 789                         *pp = p->next;
 790                         break;
 791                 }
 792         }
 793
 794         /* FIXME: How should we handle closing the handle?  At
 795            present, this code will only work correctly if the handle
 796            is closed before this code is called; otherwise, we may
 797            wait forever for the thread.  */
 798
 799         if (pipe_get_flags (p) & PIPE_HAS_THREAD) {
 800                 close (p->fd);
 801                 pipe_set_flag (p, PIPE_CLOSED);
 802                 (void) SetEvent (p->try_read);
 803                 WaitForSingleObject (p->pthread, 10000);
 804                 CloseHandle (p->pthread);
 805         } else {
 806                 CloseHandle (p->flags_mutex);
 807         }
 808         Tcl_Free ((char *) p);
 809
 810         return 0;
 811 }
 812
 813 /* Handle reading from a pipe.  This will never be called.  */
 814
 815 static int
 816 pipe_input (cd, buf, size, error)
 817 ClientData cd;
 818 char *buf;
 819 int size;
 820 int *error;
 821 {
 822         exp_errorlog ("pipe_input called");
 823         exit (-1);
 824 }
 825
 826 /* Handle writing to a pipe.  This will never be called.  */
 827
 828 static int
 829 pipe_output (cd, buf, size, error)
 830 ClientData cd;
 831 char *buf;
 832 int size;
 833 int *error;
 834 {
 835         exp_errorlog ("pipe_output called");
 836         exit (-1);
 837 }
 838
 839 /* Handle a pipe event.  This is called when a pipe event created by
 840    pipe_check reaches the head of the Tcl queue.  */
 841
 842 static int
 843 pipe_event (ev, flags)
 844 Tcl_Event *ev;
 845 int flags;
 846 {
 847         struct pipe_event *pev = (struct pipe_event *) ev;
 848         struct pipe_info *p;
 849         int mask;
 850
 851         if (! (flags & TCL_FILE_EVENTS)) {
 852                 return 0;
 853         }
 854
 855         /* Make sure the pipe is still being watched.  */
 856         for (p = pipes; p != NULL; p = p->next) {
 857                 if (p == pev->pipe) {
 858                         pipe_reset_flag (p, PIPE_PENDING);
 859                         break;
 860                 }
 861         }
 862
 863         if (p == NULL) {
 864                 return 1;
 865         }
 866
 867         if (pipe_get_flags (p) & PIPE_HAS_THREAD) {
 868                 mask = TCL_WRITABLE;
 869                 if (pipe_get_flags (p) & PIPE_READABLE) {
 870                         mask |= TCL_READABLE;
 871                 }
 872         } else {
 873                 mask = TCL_WRITABLE | TCL_READABLE;
 874         }
 875
 876         /* Tell the channel about any events.  */
 877
 878         Tcl_NotifyChannel (p->channel, p->watch_mask & mask);
 879
 880         return 1;
 881 }
 882
 883 /* Set up to watch a pipe.  */
 884
 885 static void
 886 pipe_watch (cd, mask)
 887 ClientData cd;
 888 int mask;
 889 {
 890         struct pipe_info *p = (struct pipe_info *) cd;
 891         int old_mask;
 892
 893         old_mask = p->watch_mask;
 894         p->watch_mask = mask & (TCL_READABLE | TCL_WRITABLE);
 895         if (p->watch_mask != 0) {
 896                 Tcl_Time zero_time = { 0, 0 };
 897
 898                 if ((p->watch_mask & TCL_READABLE) != 0
 899                     && (pipe_get_flags (p) & PIPE_HAS_THREAD) == 0) {
 900                         HANDLE thread;
 901                         DWORD tid;
 902
 903                         p->try_read = CreateEvent (NULL, FALSE, FALSE,
 904                                                       NULL);
 905                         pipe_set_flag (p, PIPE_HAS_THREAD);
 906                         p->pthread = CreateThread (NULL, 0, pipe_thread,
 907                                                    p, 0, &tid);
 908                         /* CYGNUS LOCAL: plug a handle leak - dj */
 909                         if (!p->pthread)
 910                           {
 911                             fprintf(stderr, "Error: cannot create pipe thread, error=%d\n", GetLastError());
 912                             exit(1);
 913                           }
 914
 915                         CloseHandle(p->pthread);
 916                 }
 917
 918                 if (old_mask == 0) {
 919                         p->next = pipes;
 920                         pipes = p;
 921                 }
 922
 923                 Tcl_SetMaxBlockTime (&zero_time);
 924         } else {
 925                 if (old_mask != 0) {
 926                         struct pipe_info **pp;
 927
 928                         for (pp = &pipes; *pp != NULL; pp = &(*pp)->next) {
 929                                 if (*pp == p) {
 930                                         *pp = p->next;
 931                                         break;
 932                                 }
 933                         }
 934                 }
 935         }
 936 }
 937
 938 /* Get the handle of a pipe.  */
 939
 940 static int
 941 pipe_get_handle (cd, dir, handle_ptr)
 942 ClientData cd;
 943 int dir;
 944 ClientData *handle_ptr;
 945 {
 946         struct pipe_info *p = (struct pipe_info *) cd;
 947
 948         *handle_ptr = (ClientData *)p->fd;
 949         return TCL_OK;
 950 }
 951
 952 /* Make a pipe channel.  */
 953
 954 static Tcl_Channel
 955 make_pipe_channel (fd, handle)
 956 int fd;
 957 HANDLE handle;
 958 {
 959         Tcl_Channel chan;
 960         struct pipe_info *p;
 961         char namebuf[30];
 962
 963         if (! pipe_initialized) {
 964                 pipe_init ();
 965         }
 966
 967         p = (struct pipe_info *) Tcl_Alloc (sizeof *p);
 968
 969         p->next = NULL;
 970         p->fd = fd;
 971         p->watch_mask = 0;
 972         p->flags = 0;
 973         p->flags_mutex = CreateMutex (NULL, FALSE, NULL);
 974         p->try_read = NULL;
 975
 976         sprintf (namebuf, "expect_pipe%d", handle);
 977         p->channel = Tcl_CreateChannel (&pipe_channel, namebuf,
 978                                         (ClientData) p,
 979                                         TCL_READABLE | TCL_WRITABLE);
 980
 981         Tcl_SetChannelOption ((Tcl_Interp *) NULL, p->channel,
 982                               "-translation", "binary");
 983
 984         return p->channel;
 985 }
 986
 987 /* This is called when we read from a file descriptor.  If that file
 988    descriptor turns out to be a pipe, we turn off the PIPE_READABLE
 989    flag.  If we didn't do this, then every time we entered the Tcl
 990    event loop we would think the pipe was readable.  If we read the
 991    pipe using Tcl channel functions, we wouldn't have this problem.  */
 992
 993 void
 994 exp_reading_from_descriptor (fd)
 995 int fd;
 996 {
 997         struct pipe_info *p;
 998
 999         for (p = pipes; p != NULL; p = p->next) {
1000                 if (p->fd == fd) {
1001                         pipe_reset_flag (p, PIPE_READABLE);
1002                         break;
1003                 }
1004         }
1005 }
1006
1007 /* Implement Tcl_CreateFileHandler for cygwin32.   */
1008
1009 void
1010 Tcl_CreateFileHandler (fd, mask, proc, cd)
1011 int fd;
1012 int mask;
1013 Tcl_FileProc *proc;
1014 ClientData cd;
1015 {
1016         if (exp_fs[fd].channel == NULL) {
1017                 HANDLE handle;
1018                 Tcl_Channel chan;
1019                 struct sockaddr sa;
1020                 int salen;
1021
1022                 /* Tcl can handle channel events on Windows for
1023                    sockets and regular files.  For pipes we defines
1024                    our own channel type.  FIXME: The channels we
1025                    create here are never deleted.  */
1026
1027                 handle = (HANDLE) get_osfhandle (fd);
1028                 if (handle == (HANDLE) -1)
1029                         abort ();
1030
1031                 chan = NULL;
1032
1033                 salen = sizeof sa;
1034                 if (getsockname (fd, &sa, &salen) == 0)
1035                         chan = Tcl_MakeTcpClientChannel ((ClientData) handle);
1036                 else if (GetFileType (handle) != FILE_TYPE_PIPE)
1037                         chan = Tcl_MakeFileChannel ((ClientData) fd,
1038                                                     (TCL_READABLE
1039                                                      | TCL_WRITABLE));
1040                 else {
1041                         /* We assume that we can always write to a
1042                            pipe.  */
1043                         if ((mask & TCL_READABLE) == 0)
1044                                 chan = Tcl_MakeFileChannel ((ClientData) fd,
1045                                                             mask);
1046                         else
1047                                 chan = make_pipe_channel (fd, handle);
1048                 }
1049
1050                 if (chan == NULL)
1051                         abort ();
1052
1053                 exp_fs[fd].channel = chan;
1054         }
1055
1056         if (exp_fs[fd].fileproc != NULL)
1057                 Tcl_DeleteChannelHandler (exp_fs[fd].channel,
1058                                           exp_fs[fd].fileproc,
1059                                           exp_fs[fd].procdata);
1060
1061         Tcl_CreateChannelHandler (exp_fs[fd].channel, mask, proc, cd);
1062         exp_fs[fd].fileproc = proc;
1063         exp_fs[fd].procdata = cd;
1064 }
1065
1066 /* Implement Tcl_DeleteFileHandler for cygwin32.   */
1067
1068 void
1069 Tcl_DeleteFileHandler (fd)
1070 int fd;
1071 {
1072         if (exp_fs[fd].channel != NULL && exp_fs[fd].fileproc != NULL) {
1073                 Tcl_DeleteChannelHandler (exp_fs[fd].channel,
1074                                           exp_fs[fd].fileproc,
1075                                           exp_fs[fd].procdata);
1076                 exp_fs[fd].fileproc = NULL;
1077         }
1078 }
1079
1080 #endif
1081 #endif /* __CYGWIN32__ */