l4/pkg/ocaml/contrib/otherlibs/win32unix/select.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*  Contributed by Sylvain Le Gall for Lexifi                          */
   6 /*                                                                     */
   7 /*  Copyright 2008 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../../LICENSE.  */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id: select.c 9143 2008-11-26 13:27:21Z xleroy $ */
  15
  16 #include <mlvalues.h>
  17 #include <alloc.h>
  18 #include <memory.h>
  19 #include <signals.h>
  20 #include <winsock2.h>
  21 #include <windows.h>
  22 #include "unixsupport.h"
  23 #include "windbug.h"
  24 #include "winworker.h"
  25 #include "winlist.h"
  26
  27 /* This constant define the maximum number of objects that
  28  * can be handle by a SELECTDATA.
  29  * It takes the following parameters into account:
  30  * - limitation on number of objects is mostly due to limitation
  31  *   a WaitForMultipleObjects
  32  * - there is always an event "hStop" to watch
  33  *
  34  * This lead to pick the following value as the biggest possible
  35  * value
  36  */
  37 #define MAXIMUM_SELECT_OBJECTS (MAXIMUM_WAIT_OBJECTS - 1)
  38
  39 /* Manage set of handle */
  40 typedef struct _SELECTHANDLESET {
  41   LPHANDLE lpHdl;
  42   DWORD    nMax;
  43   DWORD    nLast;
  44 } SELECTHANDLESET;
  45
  46 typedef SELECTHANDLESET *LPSELECTHANDLESET;
  47
  48 void handle_set_init (LPSELECTHANDLESET hds, LPHANDLE lpHdl, DWORD max)
  49 {
  50   DWORD i;
  51
  52   hds->lpHdl = lpHdl;
  53   hds->nMax  = max;
  54   hds->nLast = 0;
  55
  56   /* Set to invalid value every entry of the handle */
  57   for (i = 0; i < hds->nMax; i++)
  58   {
  59     hds->lpHdl[i] = INVALID_HANDLE_VALUE;
  60   };
  61 }
  62
  63 void handle_set_add (LPSELECTHANDLESET hds, HANDLE hdl)
  64 {
  65   LPSELECTHANDLESET res;
  66
  67   if (hds->nLast < hds->nMax)
  68   {
  69     hds->lpHdl[hds->nLast] = hdl;
  70     hds->nLast++;
  71   }
  72
  73 #ifdef DBUG
  74   dbug_print("Adding handle %x to set %x", hdl, hds);
  75 #endif
  76 }
  77
  78 BOOL handle_set_mem (LPSELECTHANDLESET hds, HANDLE hdl)
  79 {
  80   BOOL  res;
  81   DWORD i;
  82
  83   res = FALSE;
  84   for (i = 0; !res && i < hds->nLast; i++)
  85   {
  86     res = (hds->lpHdl[i] == hdl);
  87   }
  88
  89   return res;
  90 }
  91
  92 void handle_set_reset (LPSELECTHANDLESET hds)
  93 {
  94   DWORD i;
  95
  96   for (i = 0; i < hds->nMax; i++)
  97   {
  98     hds->lpHdl[i] = INVALID_HANDLE_VALUE;
  99   }
 100   hds->nMax  = 0;
 101   hds->nLast = 0;
 102   hds->lpHdl = NULL;
 103 }
 104
 105 /* Data structure for handling select */
 106
 107 typedef enum _SELECTHANDLETYPE {
 108   SELECT_HANDLE_NONE = 0,
 109   SELECT_HANDLE_DISK,
 110   SELECT_HANDLE_CONSOLE,
 111   SELECT_HANDLE_PIPE,
 112   SELECT_HANDLE_SOCKET,
 113 } SELECTHANDLETYPE;
 114
 115 typedef enum _SELECTMODE {
 116   SELECT_MODE_NONE = 0,
 117   SELECT_MODE_READ,
 118   SELECT_MODE_WRITE,
 119   SELECT_MODE_EXCEPT,
 120 } SELECTMODE;
 121
 122 typedef enum _SELECTSTATE {
 123   SELECT_STATE_NONE = 0,
 124   SELECT_STATE_INITFAILED,
 125   SELECT_STATE_ERROR,
 126   SELECT_STATE_SIGNALED
 127 } SELECTSTATE;
 128
 129 typedef enum _SELECTTYPE {
 130   SELECT_TYPE_NONE = 0,
 131   SELECT_TYPE_STATIC,       /* Result is known without running anything */
 132   SELECT_TYPE_CONSOLE_READ, /* Reading data on console */
 133   SELECT_TYPE_PIPE_READ,    /* Reading data on pipe */
 134   SELECT_TYPE_SOCKET        /* Classic select */
 135 } SELECTTYPE;
 136
 137 /* Data structure for results */
 138 typedef struct _SELECTRESULT {
 139   LIST       lst;
 140   SELECTMODE EMode;
 141   LPVOID     lpOrig;
 142 } SELECTRESULT;
 143
 144 typedef SELECTRESULT *LPSELECTRESULT;
 145
 146 /* Data structure for query */
 147 typedef struct _SELECTQUERY {
 148   LIST       lst;
 149   SELECTMODE EMode;
 150   HANDLE     hFileDescr;
 151   LPVOID     lpOrig;
 152 } SELECTQUERY;
 153
 154 typedef SELECTQUERY *LPSELECTQUERY;
 155
 156 typedef struct _SELECTDATA {
 157   LIST             lst;
 158   SELECTTYPE       EType;
 159   SELECTRESULT     aResults[MAXIMUM_SELECT_OBJECTS];
 160   DWORD            nResultsCount;
 161   /* Data following are dedicated to APC like call, they
 162      will be initialized if required.
 163      */
 164   WORKERFUNC       funcWorker;
 165   SELECTQUERY      aQueries[MAXIMUM_SELECT_OBJECTS];
 166   DWORD            nQueriesCount;
 167   SELECTSTATE      EState;
 168   DWORD            nError;
 169   LPWORKER         lpWorker;
 170 } SELECTDATA;
 171
 172 typedef SELECTDATA *LPSELECTDATA;
 173
 174 /* Get error status if associated condition is false */
 175 static BOOL check_error(LPSELECTDATA lpSelectData, BOOL bFailed)
 176 {
 177   if (bFailed && lpSelectData->nError == 0)
 178   {
 179     lpSelectData->EState = SELECT_STATE_ERROR;
 180     lpSelectData->nError = GetLastError();
 181   }
 182   return bFailed;
 183 }
 184
 185 /* Create data associated with a  select operation */
 186 LPSELECTDATA select_data_new (LPSELECTDATA lpSelectData, SELECTTYPE EType)
 187 {
 188   /* Allocate the data structure */
 189   LPSELECTDATA res;
 190   DWORD        i;
 191
 192   if (!HeapLock(GetProcessHeap()))
 193   {
 194     win32_maperr(GetLastError());
 195     uerror("select", Nothing);
 196   }
 197   res = (LPSELECTDATA)HeapAlloc(GetProcessHeap(), 0, sizeof(SELECTDATA));
 198   HeapUnlock(GetProcessHeap());
 199
 200   /* Init common data */
 201   list_init((LPLIST)res);
 202   list_next_set((LPLIST)res, (LPLIST)lpSelectData);
 203   res->EType         = EType;
 204   res->nResultsCount = 0;
 205
 206
 207   /* Data following are dedicated to APC like call, they
 208      will be initialized if required. For now they are set to
 209      invalid values.
 210      */
 211   res->funcWorker    = NULL;
 212   res->nQueriesCount = 0;
 213   res->EState        = SELECT_STATE_NONE;
 214   res->nError        = 0;
 215   res->lpWorker  = NULL;
 216
 217   return res;
 218 }
 219
 220 /* Free select data */
 221 void select_data_free (LPSELECTDATA lpSelectData)
 222 {
 223   DWORD i;
 224
 225 #ifdef DBUG
 226   dbug_print("Freeing data of %x", lpSelectData);
 227 #endif
 228
 229   /* Free APC related data, if they exists */
 230   if (lpSelectData->lpWorker != NULL)
 231   {
 232     worker_job_finish(lpSelectData->lpWorker);
 233     lpSelectData->lpWorker = NULL;
 234   };
 235
 236   /* Make sure results/queries cannot be accessed */
 237   lpSelectData->nResultsCount = 0;
 238   lpSelectData->nQueriesCount = 0;
 239
 240   if (!HeapLock(GetProcessHeap()))
 241   {
 242     win32_maperr(GetLastError());
 243     uerror("select_data_free", Nothing);
 244   };
 245   HeapFree(GetProcessHeap(), 0, lpSelectData);
 246   HeapUnlock(GetProcessHeap());
 247 }
 248
 249 /* Add a result to select data, return zero if something goes wrong. */
 250 DWORD select_data_result_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, LPVOID lpOrig)
 251 {
 252   DWORD res;
 253   DWORD i;
 254
 255   res = 0;
 256   if (lpSelectData->nResultsCount < MAXIMUM_SELECT_OBJECTS)
 257   {
 258     i = lpSelectData->nResultsCount;
 259     lpSelectData->aResults[i].EMode  = EMode;
 260     lpSelectData->aResults[i].lpOrig = lpOrig;
 261     lpSelectData->nResultsCount++;
 262     res = 1;
 263   }
 264
 265   return res;
 266 }
 267
 268 /* Add a query to select data, return zero if something goes wrong */
 269 DWORD select_data_query_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig)
 270 {
 271   DWORD res;
 272   DWORD i;
 273
 274   res = 0;
 275   if (lpSelectData->nQueriesCount < MAXIMUM_SELECT_OBJECTS)
 276   {
 277     i = lpSelectData->nQueriesCount;
 278     lpSelectData->aQueries[i].EMode      = EMode;
 279     lpSelectData->aQueries[i].hFileDescr = hFileDescr;
 280     lpSelectData->aQueries[i].lpOrig     = lpOrig;
 281     lpSelectData->nQueriesCount++;
 282     res = 1;
 283   }
 284
 285   return res;
 286 }
 287
 288 /* Search for a job that has available query slots and that match provided type.
 289  * If none is found, create a new one. Return the corresponding SELECTDATA, and
 290  * update provided SELECTDATA head, if required.
 291  */
 292 LPSELECTDATA select_data_job_search (LPSELECTDATA *lppSelectData, SELECTTYPE EType)
 293 {
 294   LPSELECTDATA res;
 295
 296   res = NULL;
 297
 298   /* Search for job */
 299 #ifdef DBUG
 300   dbug_print("Searching an available job for type %d", EType);
 301 #endif
 302   res = *lppSelectData;
 303   while (
 304       res != NULL
 305       && !(
 306         res->EType == EType
 307         && res->nQueriesCount < MAXIMUM_SELECT_OBJECTS
 308         )
 309       )
 310   {
 311     res = LIST_NEXT(LPSELECTDATA, res);
 312   }
 313
 314   /* No matching job found, create one */
 315   if (res == NULL)
 316   {
 317 #ifdef DBUG
 318     dbug_print("No job for type %d found, create one", EType);
 319 #endif
 320     res = select_data_new(*lppSelectData, EType);
 321     *lppSelectData = res;
 322   }
 323
 324   return res;
 325 }
 326
 327 /***********************/
 328 /*      Console        */
 329 /***********************/
 330
 331 void read_console_poll(HANDLE hStop, void *_data)
 332 {
 333   HANDLE events[2];
 334   INPUT_RECORD record;
 335   DWORD waitRes;
 336   DWORD n;
 337   LPSELECTDATA  lpSelectData;
 338   LPSELECTQUERY lpQuery;
 339
 340 #ifdef DBUG
 341   dbug_print("Waiting for data on console");
 342 #endif
 343
 344   record;
 345   waitRes = 0;
 346   n = 0;
 347   lpSelectData = (LPSELECTDATA)_data;
 348   lpQuery = &(lpSelectData->aQueries[0]);
 349
 350   events[0] = hStop;
 351   events[1] = lpQuery->hFileDescr;
 352   while (lpSelectData->EState == SELECT_STATE_NONE)
 353   {
 354     waitRes = WaitForMultipleObjects(2, events, FALSE, INFINITE);
 355     if (waitRes == WAIT_OBJECT_0 || check_error(lpSelectData, waitRes == WAIT_FAILED))
 356     {
 357       /* stop worker event or error */
 358       break;
 359     }
 360     /* console event */
 361     if (check_error(lpSelectData, PeekConsoleInput(lpQuery->hFileDescr, &record, 1, &n) == 0))
 362     {
 363       break;
 364     }
 365     /* check for ASCII keypress only */
 366     if (record.EventType == KEY_EVENT &&
 367       record.Event.KeyEvent.bKeyDown &&
 368       record.Event.KeyEvent.uChar.AsciiChar != 0)
 369     {
 370       select_data_result_add(lpSelectData, lpQuery->EMode, lpQuery->lpOrig);
 371       lpSelectData->EState = SELECT_STATE_SIGNALED;
 372       break;
 373     }
 374     else
 375     {
 376       /* discard everything else and try again */
 377       if (check_error(lpSelectData, ReadConsoleInput(lpQuery->hFileDescr, &record, 1, &n) == 0))
 378       {
 379         break;
 380       }
 381     }
 382   };
 383 }
 384
 385 /* Add a function to monitor console input */
 386 LPSELECTDATA read_console_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig)
 387 {
 388   LPSELECTDATA res;
 389
 390   res = select_data_new(lpSelectData, SELECT_TYPE_CONSOLE_READ);
 391   res->funcWorker = read_console_poll;
 392   select_data_query_add(res, SELECT_MODE_READ, hFileDescr, lpOrig);
 393
 394   return res;
 395 }
 396
 397 /***********************/
 398 /*        Pipe         */
 399 /***********************/
 400
 401 /* Monitor a pipe for input */
 402 void read_pipe_poll (HANDLE hStop, void *_data)
 403 {
 404   DWORD         event;
 405   DWORD         n;
 406   LPSELECTQUERY iterQuery;
 407   LPSELECTDATA  lpSelectData;
 408   DWORD         i;
 409
 410   /* Poll pipe */
 411   event = 0;
 412   n = 0;
 413   lpSelectData = (LPSELECTDATA)_data;
 414
 415 #ifdef DBUG
 416   dbug_print("Checking data pipe");
 417 #endif
 418   while (lpSelectData->EState == SELECT_STATE_NONE)
 419   {
 420     for (i = 0; i < lpSelectData->nQueriesCount; i++)
 421     {
 422       iterQuery = &(lpSelectData->aQueries[i]);
 423       if (check_error(
 424             lpSelectData,
 425             PeekNamedPipe(
 426               iterQuery->hFileDescr,
 427               NULL,
 428               0,
 429               NULL,
 430               &n,
 431               NULL) == 0))
 432       {
 433         break;
 434       };
 435
 436       if (n > 0)
 437       {
 438         lpSelectData->EState = SELECT_STATE_SIGNALED;
 439         select_data_result_add(lpSelectData, iterQuery->EMode, iterQuery->lpOrig);
 440       };
 441     };
 442
 443     /* Alas, nothing except polling seems to work for pipes.
 444        Check the state & stop_worker_event every 10 ms
 445      */
 446     if (lpSelectData->EState == SELECT_STATE_NONE)
 447     {
 448       event = WaitForSingleObject(hStop, 10);
 449       if (event == WAIT_OBJECT_0 || check_error(lpSelectData, event == WAIT_FAILED))
 450       {
 451         break;
 452       }
 453     }
 454   }
 455 #ifdef DBUG
 456   dbug_print("Finish checking data on pipe");
 457 #endif
 458 }
 459
 460 /* Add a function to monitor pipe input */
 461 LPSELECTDATA read_pipe_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig)
 462 {
 463   LPSELECTDATA res;
 464   LPSELECTDATA hd;
 465
 466   hd = lpSelectData;
 467   /* Polling pipe is a non blocking operation by default. This means that each
 468      worker can handle many pipe. We begin to try to find a worker that is
 469      polling pipe, but for which there is under the limit of pipe per worker.
 470      */
 471 #ifdef DBUG
 472   dbug_print("Searching an available worker handling pipe");
 473 #endif
 474   res = select_data_job_search(&hd, SELECT_TYPE_PIPE_READ);
 475
 476   /* Add a new pipe to poll */
 477   res->funcWorker = read_pipe_poll;
 478   select_data_query_add(res, EMode, hFileDescr, lpOrig);
 479
 480   return hd;
 481 }
 482
 483 /***********************/
 484 /*       Socket        */
 485 /***********************/
 486
 487 /* Monitor socket */
 488 void socket_poll (HANDLE hStop, void *_data)
 489 {
 490   LPSELECTDATA   lpSelectData;
 491   LPSELECTQUERY  iterQuery;
 492   HANDLE         aEvents[MAXIMUM_SELECT_OBJECTS];
 493   DWORD          nEvents;
 494   long           maskEvents;
 495   DWORD          i;
 496   u_long         iMode;
 497
 498   lpSelectData = (LPSELECTDATA)_data;
 499
 500   for (nEvents = 0; nEvents < lpSelectData->nQueriesCount; nEvents++)
 501   {
 502     iterQuery = &(lpSelectData->aQueries[nEvents]);
 503     aEvents[nEvents] = CreateEvent(NULL, TRUE, FALSE, NULL);
 504     maskEvents = 0;
 505     switch (iterQuery->EMode)
 506     {
 507       case SELECT_MODE_READ:
 508         maskEvents = FD_READ | FD_ACCEPT | FD_CLOSE;
 509         break;
 510       case SELECT_MODE_WRITE:
 511         maskEvents = FD_WRITE | FD_CONNECT | FD_CLOSE;
 512         break;
 513       case SELECT_MODE_EXCEPT:
 514         maskEvents = FD_OOB;
 515         break;
 516     }
 517     check_error(lpSelectData,
 518         WSAEventSelect(
 519           (SOCKET)(iterQuery->hFileDescr),
 520           aEvents[nEvents],
 521           maskEvents) == SOCKET_ERROR);
 522   }
 523
 524   /* Add stop event */
 525   aEvents[nEvents]  = hStop;
 526   nEvents++;
 527
 528   if (lpSelectData->nError == 0)
 529   {
 530     check_error(lpSelectData,
 531         WaitForMultipleObjects(
 532           nEvents,
 533           aEvents,
 534           FALSE,
 535           INFINITE) == WAIT_FAILED);
 536   };
 537
 538   if (lpSelectData->nError == 0)
 539   {
 540     for (i = 0; i < lpSelectData->nQueriesCount; i++)
 541     {
 542       iterQuery = &(lpSelectData->aQueries[i]);
 543       if (WaitForSingleObject(aEvents[i], 0) == WAIT_OBJECT_0)
 544       {
 545 #ifdef DBUG
 546         dbug_print("Socket %d has pending events", (i - 1));
 547 #endif
 548         if (iterQuery != NULL)
 549         {
 550           select_data_result_add(lpSelectData, iterQuery->EMode, iterQuery->lpOrig);
 551         }
 552       }
 553       /* WSAEventSelect() automatically sets socket to nonblocking mode.
 554          Restore the blocking one. */
 555       iMode = 0;
 556       check_error(lpSelectData,
 557         WSAEventSelect((SOCKET)(iterQuery->hFileDescr), aEvents[i], 0) != 0 ||
 558         ioctlsocket((SOCKET)(iterQuery->hFileDescr), FIONBIO, &iMode) != 0);
 559
 560       CloseHandle(aEvents[i]);
 561       aEvents[i] = INVALID_HANDLE_VALUE;
 562     }
 563   }
 564 }
 565
 566 /* Add a function to monitor socket */
 567 LPSELECTDATA socket_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig)
 568 {
 569   LPSELECTDATA res;
 570   LPSELECTDATA hd;
 571
 572   hd = lpSelectData;
 573   /* Polling socket can be done mulitple handle at the same time. You just
 574      need one worker to use it. Try to find if there is already a worker
 575      handling this kind of request.
 576      */
 577 #ifdef DBUG
 578   dbug_print("Scanning list of worker to find one that already handle socket");
 579 #endif
 580   res = select_data_job_search(&hd, SELECT_TYPE_SOCKET);
 581
 582   /* Add a new socket to poll */
 583   res->funcWorker = socket_poll;
 584 #ifdef DBUG
 585   dbug_print("Add socket %x to worker", hFileDescr);
 586 #endif
 587   select_data_query_add(res, EMode, hFileDescr, lpOrig);
 588 #ifdef DBUG
 589   dbug_print("Socket %x added", hFileDescr);
 590 #endif
 591
 592   return hd;
 593 }
 594
 595 /***********************/
 596 /*       Static        */
 597 /***********************/
 598
 599 /* Add a static result */
 600 LPSELECTDATA static_poll_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, HANDLE hFileDescr, LPVOID lpOrig)
 601 {
 602   LPSELECTDATA res;
 603   LPSELECTDATA hd;
 604
 605   /* Look for an already initialized static element */
 606   hd = lpSelectData;
 607   res = select_data_job_search(&hd, SELECT_TYPE_STATIC);
 608
 609   /* Add a new query/result */
 610   select_data_query_add(res, EMode, hFileDescr, lpOrig);
 611   select_data_result_add(res, EMode, lpOrig);
 612
 613   return hd;
 614 }
 615
 616 /********************************/
 617 /* Generic select data handling */
 618 /********************************/
 619
 620 /* Guess handle type */
 621 static SELECTHANDLETYPE get_handle_type(value fd)
 622 {
 623   DWORD            mode;
 624   SELECTHANDLETYPE res;
 625
 626   CAMLparam1(fd);
 627
 628   mode = 0;
 629   res = SELECT_HANDLE_NONE;
 630
 631   if (Descr_kind_val(fd) == KIND_SOCKET)
 632   {
 633     res = SELECT_HANDLE_SOCKET;
 634   }
 635   else
 636   {
 637     switch(GetFileType(Handle_val(fd)))
 638     {
 639       case FILE_TYPE_DISK:
 640         res = SELECT_HANDLE_DISK;
 641         break;
 642
 643       case FILE_TYPE_CHAR: /* character file or a console */
 644         if (GetConsoleMode(Handle_val(fd), &mode) != 0)
 645         {
 646           res = SELECT_HANDLE_CONSOLE;
 647         }
 648         else
 649         {
 650           res = SELECT_HANDLE_NONE;
 651         };
 652         break;
 653
 654       case FILE_TYPE_PIPE: /* a named or an anonymous pipe (socket already handled) */
 655         res = SELECT_HANDLE_PIPE;
 656         break;
 657     };
 658   };
 659
 660   CAMLreturnT(SELECTHANDLETYPE, res);
 661 }
 662
 663 /* Choose what to do with given data */
 664 LPSELECTDATA select_data_dispatch (LPSELECTDATA lpSelectData, SELECTMODE EMode, value fd)
 665 {
 666   LPSELECTDATA    res;
 667   HANDLE          hFileDescr;
 668   void           *lpOrig;
 669   struct sockaddr sa;
 670   int             sa_len;
 671   BOOL            alreadyAdded;
 672
 673   CAMLparam1(fd);
 674
 675   res          = lpSelectData;
 676   hFileDescr   = Handle_val(fd);
 677   lpOrig       = (void *)fd;
 678   sa_len       = sizeof(sa);
 679   alreadyAdded = FALSE;
 680
 681 #ifdef DBUG
 682   dbug_print("Begin dispatching handle %x", hFileDescr);
 683 #endif
 684
 685 #ifdef DBUG
 686   dbug_print("Waiting for %d on handle %x", EMode, hFileDescr);
 687 #endif
 688
 689   /* There is only 2 way to have except mode: transmission of OOB data through
 690      a socket TCP/IP and through a strange interaction with a TTY.
 691      With windows, we only consider the TCP/IP except condition
 692   */
 693   switch(get_handle_type(fd))
 694   {
 695     case SELECT_HANDLE_DISK:
 696 #ifdef DBUG
 697       dbug_print("Handle %x is a disk handle", hFileDescr);
 698 #endif
 699       /* Disk is always ready in read/write operation */
 700       if (EMode == SELECT_MODE_READ || EMode == SELECT_MODE_WRITE)
 701       {
 702         res = static_poll_add(res, EMode, hFileDescr, lpOrig);
 703       };
 704       break;
 705
 706     case SELECT_HANDLE_CONSOLE:
 707 #ifdef DBUG
 708       dbug_print("Handle %x is a console handle", hFileDescr);
 709 #endif
 710       /* Console is always ready in write operation, need to check for read. */
 711       if (EMode == SELECT_MODE_READ)
 712       {
 713         res = read_console_poll_add(res, EMode, hFileDescr, lpOrig);
 714       }
 715       else if (EMode == SELECT_MODE_WRITE)
 716       {
 717         res = static_poll_add(res, EMode, hFileDescr, lpOrig);
 718       };
 719       break;
 720
 721     case SELECT_HANDLE_PIPE:
 722 #ifdef DBUG
 723       dbug_print("Handle %x is a pipe handle", hFileDescr);
 724 #endif
 725       /* Console is always ready in write operation, need to check for read. */
 726       if (EMode == SELECT_MODE_READ)
 727       {
 728 #ifdef DBUG
 729         dbug_print("Need to check availability of data on pipe");
 730 #endif
 731         res = read_pipe_poll_add(res, EMode, hFileDescr, lpOrig);
 732       }
 733       else if (EMode == SELECT_MODE_WRITE)
 734       {
 735 #ifdef DBUG
 736         dbug_print("No need to check availability of data on pipe, write operation always possible");
 737 #endif
 738         res = static_poll_add(res, EMode, hFileDescr, lpOrig);
 739       };
 740       break;
 741
 742     case SELECT_HANDLE_SOCKET:
 743 #ifdef DBUG
 744       dbug_print("Handle %x is a socket handle", hFileDescr);
 745 #endif
 746       if (getsockname((SOCKET)hFileDescr, &sa, &sa_len) == SOCKET_ERROR)
 747       {
 748         if (WSAGetLastError() == WSAEINVAL)
 749         {
 750           /* Socket is not bound */
 751 #ifdef DBUG
 752           dbug_print("Socket is not connected");
 753 #endif
 754           if (EMode == SELECT_MODE_WRITE || EMode == SELECT_MODE_READ)
 755           {
 756             res = static_poll_add(res, EMode, hFileDescr, lpOrig);
 757             alreadyAdded = TRUE;
 758           }
 759         }
 760       }
 761       if (!alreadyAdded)
 762       {
 763         res = socket_poll_add(res, EMode, hFileDescr, lpOrig);
 764       }
 765       break;
 766
 767     default:
 768 #ifdef DBUG
 769       dbug_print("Handle %x is unknown", hFileDescr);
 770 #endif
 771       caml_failwith("Unknown handle");
 772       break;
 773   };
 774
 775 #ifdef DBUG
 776   dbug_print("Finish dispatching handle %x", hFileDescr);
 777 #endif
 778
 779   CAMLreturnT(LPSELECTDATA, res);
 780 }
 781
 782 static DWORD caml_list_length (value lst)
 783 {
 784   DWORD res;
 785
 786   CAMLparam1 (lst);
 787   CAMLlocal1 (l);
 788
 789   for (res = 0, l = lst; l != Val_int(0); l = Field(l, 1), res++)
 790   { }
 791
 792   CAMLreturnT(DWORD, res);
 793 }
 794
 795 #define MAX(a, b) ((a) > (b) ? (a) : (b))
 796
 797 CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value timeout)
 798 {
 799   /* Event associated to handle */
 800   DWORD   nEventsCount;
 801   DWORD   nEventsMax;
 802   HANDLE *lpEventsDone;
 803
 804   /* Data for all handles */
 805   LPSELECTDATA lpSelectData;
 806   LPSELECTDATA iterSelectData;
 807
 808   /* Iterator for results */
 809   LPSELECTRESULT iterResult;
 810
 811   /* Iterator */
 812   DWORD i;
 813
 814   /* Error status */
 815   DWORD err;
 816
 817   /* Time to wait */
 818   DWORD milliseconds;
 819
 820   /* Is there static select data */
 821   BOOL  hasStaticData = FALSE;
 822
 823   /* Wait return */
 824   DWORD waitRet;
 825
 826   /* Set of handle */
 827   SELECTHANDLESET hds;
 828   DWORD           hdsMax;
 829   LPHANDLE        hdsData;
 830
 831   /* Length of each list */
 832   DWORD readfds_len;
 833   DWORD writefds_len;
 834   DWORD exceptfds_len;
 835
 836   CAMLparam4 (readfds, writefds, exceptfds, timeout);
 837   CAMLlocal5 (read_list, write_list, except_list, res, l);
 838   CAMLlocal1 (fd);
 839
 840 #ifdef DBUG
 841   dbug_print("in select");
 842 #endif
 843
 844   nEventsCount   = 0;
 845   nEventsMax     = 0;
 846   lpEventsDone   = NULL;
 847   lpSelectData   = NULL;
 848   iterSelectData = NULL;
 849   iterResult     = NULL;
 850   err            = 0;
 851   hasStaticData  = 0;
 852   waitRet        = 0;
 853   readfds_len    = caml_list_length(readfds);
 854   writefds_len   = caml_list_length(writefds);
 855   exceptfds_len  = caml_list_length(exceptfds);
 856   hdsMax         = MAX(readfds_len, MAX(writefds_len, exceptfds_len));
 857
 858   if (!HeapLock(GetProcessHeap()))
 859   {
 860     win32_maperr(GetLastError());
 861     uerror("select", Nothing);
 862   }
 863   hdsData = (HANDLE *)HeapAlloc(
 864       GetProcessHeap(),
 865       0,
 866       sizeof(HANDLE) * hdsMax);
 867   HeapUnlock(GetProcessHeap());
 868
 869   if (Double_val(timeout) >= 0.0)
 870   {
 871     milliseconds = 1000 * Double_val(timeout);
 872 #ifdef DBUG
 873     dbug_print("Will wait %d ms", milliseconds);
 874 #endif
 875   }
 876   else
 877   {
 878     milliseconds = INFINITE;
 879   }
 880
 881
 882   /* Create list of select data, based on the different list of fd to watch */
 883 #ifdef DBUG
 884   dbug_print("Dispatch read fd");
 885 #endif
 886   handle_set_init(&hds, hdsData, hdsMax);
 887   for (l = readfds; l != Val_int(0); l = Field(l, 1))
 888   {
 889     fd = Field(l, 0);
 890     if (!handle_set_mem(&hds, Handle_val(fd)))
 891     {
 892       handle_set_add(&hds, Handle_val(fd));
 893       lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_READ, fd);
 894     }
 895     else
 896     {
 897 #ifdef DBUG
 898       dbug_print("Discarding handle %x which is already monitor for read", Handle_val(fd));
 899 #endif
 900     }
 901   }
 902   handle_set_reset(&hds);
 903
 904 #ifdef DBUG
 905   dbug_print("Dispatch write fd");
 906 #endif
 907   handle_set_init(&hds, hdsData, hdsMax);
 908   for (l = writefds; l != Val_int(0); l = Field(l, 1))
 909   {
 910     fd = Field(l, 0);
 911     if (!handle_set_mem(&hds, Handle_val(fd)))
 912     {
 913       handle_set_add(&hds, Handle_val(fd));
 914       lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_WRITE, fd);
 915     }
 916     else
 917     {
 918 #ifdef DBUG
 919       dbug_print("Discarding handle %x which is already monitor for write", Handle_val(fd));
 920 #endif
 921     }
 922   }
 923   handle_set_reset(&hds);
 924
 925 #ifdef DBUG
 926   dbug_print("Dispatch exceptional fd");
 927 #endif
 928   handle_set_init(&hds, hdsData, hdsMax);
 929   for (l = exceptfds; l != Val_int(0); l = Field(l, 1))
 930   {
 931     fd = Field(l, 0);
 932     if (!handle_set_mem(&hds, Handle_val(fd)))
 933     {
 934       handle_set_add(&hds, Handle_val(fd));
 935       lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_EXCEPT, fd);
 936     }
 937     else
 938     {
 939 #ifdef DBUG
 940       dbug_print("Discarding handle %x which is already monitor for exceptional", Handle_val(fd));
 941 #endif
 942     }
 943   }
 944   handle_set_reset(&hds);
 945
 946   /* Building the list of handle to wait for */
 947 #ifdef DBUG
 948   dbug_print("Building events done array");
 949 #endif
 950   nEventsMax   = list_length((LPLIST)lpSelectData);
 951   nEventsCount = 0;
 952   if (!HeapLock(GetProcessHeap()))
 953   {
 954     win32_maperr(GetLastError());
 955     uerror("select", Nothing);
 956   }
 957   lpEventsDone = (HANDLE *)HeapAlloc(GetProcessHeap(), 0, sizeof(HANDLE) * nEventsMax);
 958   HeapUnlock(GetProcessHeap());
 959
 960   iterSelectData = lpSelectData;
 961   while (iterSelectData != NULL)
 962   {
 963     /* Check if it is static data. If this is the case, launch everything
 964      * but don't wait for events. It helps to test if there are events on
 965      * any other fd (which are not static), knowing that there is at least
 966      * one result (the static data).
 967      */
 968     if (iterSelectData->EType == SELECT_TYPE_STATIC)
 969     {
 970       hasStaticData = TRUE;
 971     };
 972
 973     /* Execute APC */
 974     if (iterSelectData->funcWorker != NULL)
 975     {
 976       iterSelectData->lpWorker =
 977         worker_job_submit(
 978             iterSelectData->funcWorker,
 979             (void *)iterSelectData);
 980 #ifdef DBUG
 981       dbug_print("Job submitted to worker %x", iterSelectData->lpWorker);
 982 #endif
 983       lpEventsDone[nEventsCount] = worker_job_event_done(iterSelectData->lpWorker);
 984       nEventsCount++;
 985     };
 986     iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
 987   };
 988
 989 #ifdef DBUG
 990   dbug_print("Need to watch %d workers", nEventsCount);
 991 #endif
 992
 993   /* Processing select itself */
 994   enter_blocking_section();
 995   /* There are worker started, waiting to be monitored */
 996   if (nEventsCount > 0)
 997   {
 998     /* Waiting for event */
 999     if (err == 0 && !hasStaticData)
1000     {
1001 #ifdef DBUG
1002       dbug_print("Waiting for one select worker to be done");
1003 #endif
1004       switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, FALSE, milliseconds))
1005       {
1006         case WAIT_FAILED:
1007           err = GetLastError();
1008           break;
1009
1010         case WAIT_TIMEOUT:
1011 #ifdef DBUG
1012           dbug_print("Select timeout");
1013 #endif
1014           break;
1015
1016         default:
1017 #ifdef DBUG
1018           dbug_print("One worker is done");
1019 #endif
1020           break;
1021       };
1022     }
1023
1024     /* Ordering stop to every worker */
1025 #ifdef DBUG
1026     dbug_print("Sending stop signal to every select workers");
1027 #endif
1028     iterSelectData = lpSelectData;
1029     while (iterSelectData != NULL)
1030     {
1031       if (iterSelectData->lpWorker != NULL)
1032       {
1033         worker_job_stop(iterSelectData->lpWorker);
1034       };
1035       iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
1036     };
1037
1038 #ifdef DBUG
1039     dbug_print("Waiting for every select worker to be done");
1040 #endif
1041     switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, TRUE, INFINITE))
1042     {
1043       case WAIT_FAILED:
1044         err = GetLastError();
1045         break;
1046
1047       default:
1048 #ifdef DBUG
1049         dbug_print("Every worker is done");
1050 #endif
1051         break;
1052     }
1053   }
1054   /* Nothing to monitor but some time to wait. */
1055   else if (!hasStaticData)
1056   {
1057     Sleep(milliseconds);
1058   }
1059   leave_blocking_section();
1060
1061 #ifdef DBUG
1062   dbug_print("Error status: %d (0 is ok)", err);
1063 #endif
1064   /* Build results */
1065   if (err == 0)
1066   {
1067 #ifdef DBUG
1068     dbug_print("Building result");
1069 #endif
1070     read_list = Val_unit;
1071     write_list = Val_unit;
1072     except_list = Val_unit;
1073
1074     iterSelectData = lpSelectData;
1075     while (iterSelectData != NULL)
1076     {
1077       for (i = 0; i < iterSelectData->nResultsCount; i++)
1078       {
1079         iterResult = &(iterSelectData->aResults[i]);
1080         l = alloc_small(2, 0);
1081         Store_field(l, 0, (value)iterResult->lpOrig);
1082         switch (iterResult->EMode)
1083         {
1084         case SELECT_MODE_READ:
1085           Store_field(l, 1, read_list);
1086           read_list = l;
1087           break;
1088         case SELECT_MODE_WRITE:
1089           Store_field(l, 1, write_list);
1090           write_list = l;
1091           break;
1092         case SELECT_MODE_EXCEPT:
1093           Store_field(l, 1, except_list);
1094           except_list = l;
1095           break;
1096         }
1097       }
1098       /* We try to only process the first error, bypass other errors */
1099       if (err == 0 && iterSelectData->EState == SELECT_STATE_ERROR)
1100       {
1101         err = iterSelectData->nError;
1102       }
1103       iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
1104     }
1105   }
1106
1107   /* Free resources */
1108 #ifdef DBUG
1109   dbug_print("Free selectdata resources");
1110 #endif
1111   iterSelectData = lpSelectData;
1112   while (iterSelectData != NULL)
1113   {
1114     lpSelectData = iterSelectData;
1115     iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
1116     select_data_free(lpSelectData);
1117   }
1118   lpSelectData = NULL;
1119
1120   /* Free allocated events/handle set array */
1121 #ifdef DBUG
1122   dbug_print("Free local allocated resources");
1123 #endif
1124   if (!HeapLock(GetProcessHeap()))
1125   {
1126     win32_maperr(GetLastError());
1127     uerror("select", Nothing);
1128   }
1129   HeapFree(GetProcessHeap(), 0, lpEventsDone);
1130   HeapFree(GetProcessHeap(), 0, hdsData);
1131   HeapUnlock(GetProcessHeap());
1132
1133 #ifdef DBUG
1134   dbug_print("Raise error if required");
1135 #endif
1136   if (err != 0)
1137   {
1138     win32_maperr(err);
1139     uerror("select", Nothing);
1140   }
1141
1142 #ifdef DBUG
1143   dbug_print("Build final result");
1144 #endif
1145   res = alloc_small(3, 0);
1146   Store_field(res, 0, read_list);
1147   Store_field(res, 1, write_list);
1148   Store_field(res, 2, except_list);
1149
1150 #ifdef DBUG
1151   dbug_print("out select");
1152 #endif
1153
1154   CAMLreturn(res);
1155 }