git.chise.org Git - chise/xemacs-chise.git.1/blob - src/process-nt.c

   1 /* Asynchronous subprocess implementation for Win32
   2    Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
   3    Free Software Foundation, Inc.
   4    Copyright (C) 1995 Sun Microsystems, Inc.
   5    Copyright (C) 1995, 1996 Ben Wing.
   6
   7 This file is part of XEmacs.
   8
   9 XEmacs is free software; you can redistribute it and/or modify it
  10 under the terms of the GNU General Public License as published by the
  11 Free Software Foundation; either version 2, or (at your option) any
  12 later version.
  13
  14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  16 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  17 for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with XEmacs; see the file COPYING.  If not, write to
  21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 Boston, MA 02111-1307, USA.  */
  23
  24 /* Written by Kirill M. Katsnelson <kkm@kis.ru>, April 1998 */
  25
  26 #include <config.h>
  27 #include "lisp.h"
  28
  29 #include "hash.h"
  30 #include "lstream.h"
  31 #include "process.h"
  32 #include "procimpl.h"
  33 #include "sysdep.h"
  34
  35 #ifndef __MINGW32__
  36 #include <shellapi.h>
  37 #else
  38 #include <errno.h>
  39 #endif
  40 #include <signal.h>
  41 #ifdef HAVE_SOCKETS
  42 #include <winsock.h>
  43 #endif
  44
  45 /* Arbitrary size limit for code fragments passed to run_in_other_process */
  46 #define FRAGMENT_CODE_SIZE 32
  47
  48 /* Bound by winnt.el */
  49 Lisp_Object Qnt_quote_process_args;
  50
  51 /* Implementation-specific data. Pointed to by Lisp_Process->process_data */
  52 struct nt_process_data
  53 {
  54   HANDLE h_process;
  55   int need_enable_child_signals;
  56 };
  57
  58 #define NT_DATA(p) ((struct nt_process_data*)((p)->process_data))
  59 \f
  60 /*-----------------------------------------------------------------------*/
  61 /* Process helpers                                                       */
  62 /*-----------------------------------------------------------------------*/
  63
  64 /* This one breaks process abstraction. Prototype is in console-msw.h,
  65    used by select_process method in event-msw.c */
  66 HANDLE
  67 get_nt_process_handle (Lisp_Process *p)
  68 {
  69   return (NT_DATA (p)->h_process);
  70 }
  71 \f
  72 /*-----------------------------------------------------------------------*/
  73 /* Running remote threads. See Microsoft Systems Journal 1994 Number 5   */
  74 /* Jeffrey Richter, Load Your 32-bit DLL into Another Process's Address..*/
  75 /*-----------------------------------------------------------------------*/
  76
  77 typedef struct
  78 {
  79   HANDLE h_process;
  80   HANDLE h_thread;
  81   LPVOID address;
  82 } process_memory;
  83
  84 /*
  85  * Allocate SIZE bytes in H_PROCESS address space. Fill in PMC used
  86  * further by other routines. Return nonzero if successful.
  87  *
  88  * The memory in other process is allocated by creating a suspended
  89  * thread. Initial stack of that thread is used as the memory
  90  * block. The thread entry point is the routine ExitThread in
  91  * kernel32.dll, so the allocated memory is freed just by resuming the
  92  * thread, which immediately terminates after that.
  93  */
  94
  95 static int
  96 alloc_process_memory (HANDLE h_process, size_t size,
  97                       process_memory* pmc)
  98 {
  99   LPTHREAD_START_ROUTINE adr_ExitThread =
 100     (LPTHREAD_START_ROUTINE)
 101     GetProcAddress (GetModuleHandle ("kernel32"), "ExitThread");
 102   DWORD dw_unused;
 103   CONTEXT context;
 104   MEMORY_BASIC_INFORMATION mbi;
 105
 106   pmc->h_process = h_process;
 107   pmc->h_thread = CreateRemoteThread (h_process, NULL, size,
 108                                      adr_ExitThread, NULL,
 109                                      CREATE_SUSPENDED, &dw_unused);
 110   if (pmc->h_thread == NULL)
 111     return 0;
 112
 113   /* Get context, for thread's stack pointer */
 114   context.ContextFlags = CONTEXT_CONTROL;
 115   if (!GetThreadContext (pmc->h_thread, &context))
 116     goto failure;
 117
 118   /* Determine base address of the committed range */
 119   if (sizeof(mbi) != VirtualQueryEx (h_process,
 120 #if defined (_X86_)
 121                                      (LPDWORD)context.Esp - 1,
 122 #elif defined (_ALPHA_)
 123                                      (LPDWORD)context.IntSp - 1,
 124 #else
 125 #error Unknown processor architecture
 126 #endif
 127                                      &mbi, sizeof(mbi)))
 128     goto failure;
 129
 130   /* Change the page protection of the allocated memory to executable,
 131      read, and write. */
 132   if (!VirtualProtectEx (h_process, mbi.BaseAddress, size,
 133                          PAGE_EXECUTE_READWRITE, &dw_unused))
 134     goto failure;
 135
 136   pmc->address = mbi.BaseAddress;
 137   return 1;
 138
 139  failure:
 140   ResumeThread (pmc->h_thread);
 141   pmc->address = 0;
 142   return 0;
 143 }
 144
 145 static void
 146 free_process_memory (process_memory* pmc)
 147 {
 148   ResumeThread (pmc->h_thread);
 149 }
 150
 151 /*
 152  * Run ROUTINE in the context of process determined by H_PROCESS. The
 153  * routine is passed the address of DATA as parameter. The ROUTINE must
 154  * not be longer than ROUTINE_CODE_SIZE bytes. DATA_SIZE is the size of
 155  * DATA structure.
 156  *
 157  * Note that the code must be positionally independent, and compiled
 158  * without stack checks (they cause implicit calls into CRT so will
 159  * fail). DATA should not refer any data in calling process, as both
 160  * routine and its data are copied into remote process. Size of data
 161  * and code together should not exceed one page (4K on x86 systems).
 162  *
 163  * Return the value returned by ROUTINE, or (DWORD)-1 if call failed.
 164  */
 165 static DWORD
 166 run_in_other_process (HANDLE h_process,
 167                       LPTHREAD_START_ROUTINE routine,
 168                       LPVOID data, size_t data_size)
 169 {
 170   process_memory pm;
 171   const size_t code_size = FRAGMENT_CODE_SIZE;
 172   /* Need at most 3 extra bytes of memory, for data alignment */
 173   size_t total_size = code_size + data_size + 3;
 174   LPVOID remote_data;
 175   HANDLE h_thread;
 176   DWORD dw_unused;
 177
 178   /* Allocate memory */
 179   if (!alloc_process_memory (h_process, total_size, &pm))
 180     return (DWORD)-1;
 181
 182   /* Copy code */
 183   if (!WriteProcessMemory (h_process, pm.address, (LPVOID)routine,
 184                            code_size, NULL))
 185     goto failure;
 186
 187   /* Copy data */
 188   if (data_size)
 189     {
 190       remote_data = (LPBYTE)pm.address + ((code_size + 4) & ~3);
 191       if (!WriteProcessMemory (h_process, remote_data, data, data_size, NULL))
 192         goto failure;
 193     }
 194   else
 195     remote_data = NULL;
 196
 197   /* Execute the remote copy of code, passing it remote data */
 198   h_thread = CreateRemoteThread (h_process, NULL, 0,
 199                                  (LPTHREAD_START_ROUTINE) pm.address,
 200                                  remote_data, 0, &dw_unused);
 201   if (h_thread == NULL)
 202     goto failure;
 203
 204   /* Wait till thread finishes */
 205   WaitForSingleObject (h_thread, INFINITE);
 206
 207   /* Free remote memory */
 208   free_process_memory (&pm);
 209
 210   /* Return thread's exit code */
 211   {
 212     DWORD exit_code;
 213     GetExitCodeThread (h_thread, &exit_code);
 214     CloseHandle (h_thread);
 215     return exit_code;
 216   }
 217
 218  failure:
 219   free_process_memory (&pm);
 220   return (DWORD)-1;
 221 }
 222 \f
 223 /*-----------------------------------------------------------------------*/
 224 /* Sending signals                                                       */
 225 /*-----------------------------------------------------------------------*/
 226
 227 /*
 228  * We handle the following signals:
 229  *
 230  * SIGKILL, SIGTERM, SIGQUIT, SIGHUP - These four translate to ExitProcess
 231  *    executed by the remote process
 232  * SIGINT - The remote process is sent CTRL_BREAK_EVENT
 233  *
 234  * The MSVC5.0 compiler feels free to re-order functions within a
 235  * compilation unit, so we have no way of finding out the size of the
 236  * following functions. Therefore these functions must not be larger than
 237  * FRAGMENT_CODE_SIZE.
 238  */
 239
 240 /*
 241  * Sending SIGKILL
 242  */
 243 typedef struct
 244 {
 245   void (WINAPI *adr_ExitProcess) (UINT);
 246 } sigkill_data;
 247
 248 static DWORD WINAPI
 249 sigkill_proc (sigkill_data* data)
 250 {
 251   (*data->adr_ExitProcess)(255);
 252   return 1;
 253 }
 254
 255 /*
 256  * Sending break or control c
 257  */
 258 typedef struct
 259 {
 260   BOOL (WINAPI *adr_GenerateConsoleCtrlEvent) (DWORD, DWORD);
 261   DWORD event;
 262 } sigint_data;
 263
 264 static DWORD WINAPI
 265 sigint_proc (sigint_data* data)
 266 {
 267   return (*data->adr_GenerateConsoleCtrlEvent) (data->event, 0);
 268 }
 269
 270 /*
 271  * Enabling signals
 272  */
 273 typedef struct
 274 {
 275   BOOL (WINAPI *adr_SetConsoleCtrlHandler) (LPVOID, BOOL);
 276 } sig_enable_data;
 277
 278 static DWORD WINAPI
 279 sig_enable_proc (sig_enable_data* data)
 280 {
 281   (*data->adr_SetConsoleCtrlHandler) (NULL, FALSE);
 282   return 1;
 283 }
 284
 285 /*
 286  * Send signal SIGNO to process H_PROCESS.
 287  * Return nonzero if successful.
 288  */
 289
 290 /* This code assigns a return value of GetProcAddress to function pointers
 291    of many different types. Instead of heavy obscure casts, we just disable
 292    warnings about assignments to different function pointer types. */
 293 #pragma warning (disable : 4113)
 294
 295 static int
 296 send_signal (HANDLE h_process, int signo)
 297 {
 298   HMODULE h_kernel = GetModuleHandle ("kernel32");
 299   DWORD retval;
 300
 301   assert (h_kernel != NULL);
 302
 303   switch (signo)
 304     {
 305     case SIGKILL:
 306     case SIGTERM:
 307     case SIGQUIT:
 308     case SIGHUP:
 309       {
 310         sigkill_data d;
 311         d.adr_ExitProcess = GetProcAddress (h_kernel, "ExitProcess");
 312         assert (d.adr_ExitProcess);
 313         retval = run_in_other_process (h_process,
 314                                        (LPTHREAD_START_ROUTINE)sigkill_proc,
 315                                        &d, sizeof (d));
 316         break;
 317       }
 318     case SIGINT:
 319       {
 320         sigint_data d;
 321         d.adr_GenerateConsoleCtrlEvent =
 322           GetProcAddress (h_kernel, "GenerateConsoleCtrlEvent");
 323         assert (d.adr_GenerateConsoleCtrlEvent);
 324         d.event = CTRL_C_EVENT;
 325         retval = run_in_other_process (h_process,
 326                                        (LPTHREAD_START_ROUTINE)sigint_proc,
 327                                        &d, sizeof (d));
 328         break;
 329       }
 330     default:
 331       assert (0);
 332     }
 333
 334   return (int)retval > 0 ? 1 : 0;
 335 }
 336
 337 /*
 338  * Enable CTRL_C_EVENT handling in a new child process
 339  */
 340 static void
 341 enable_child_signals (HANDLE h_process)
 342 {
 343   HMODULE h_kernel = GetModuleHandle ("kernel32");
 344   sig_enable_data d;
 345
 346   assert (h_kernel != NULL);
 347   d.adr_SetConsoleCtrlHandler =
 348     GetProcAddress (h_kernel, "SetConsoleCtrlHandler");
 349   assert (d.adr_SetConsoleCtrlHandler);
 350   run_in_other_process (h_process, (LPTHREAD_START_ROUTINE)sig_enable_proc,
 351                         &d, sizeof (d));
 352 }
 353
 354 #pragma warning (default : 4113)
 355
 356 /*
 357  * Signal error if SIGNO is not supported
 358  */
 359 static void
 360 validate_signal_number (int signo)
 361 {
 362   if (signo != SIGKILL && signo != SIGTERM
 363       && signo != SIGQUIT && signo != SIGINT
 364       && signo != SIGHUP)
 365     signal_simple_error ("Signal number not supported", make_int (signo));
 366 }
 367 \f
 368 /*-----------------------------------------------------------------------*/
 369 /* Process methods                                                       */
 370 /*-----------------------------------------------------------------------*/
 371
 372 /*
 373  * Allocate and initialize Lisp_Process->process_data
 374  */
 375
 376 static void
 377 nt_alloc_process_data (Lisp_Process *p)
 378 {
 379   p->process_data = xnew_and_zero (struct nt_process_data);
 380 }
 381
 382 static void
 383 nt_finalize_process_data (Lisp_Process *p, int for_disksave)
 384 {
 385   assert (!for_disksave);
 386   if (NT_DATA(p)->h_process)
 387     CloseHandle (NT_DATA(p)->h_process);
 388 }
 389
 390 /*
 391  * Initialize XEmacs process implementation once
 392  */
 393 static void
 394 nt_init_process (void)
 395 {
 396   /* Initialize winsock */
 397   WSADATA wsa_data;
 398   /* Request Winsock v1.1 Note the order: (minor=1, major=1) */
 399   WSAStartup (MAKEWORD (1,1), &wsa_data);
 400 }
 401
 402 /*
 403  * Fork off a subprocess. P is a pointer to newly created subprocess
 404  * object. If this function signals, the caller is responsible for
 405  * deleting (and finalizing) the process object.
 406  *
 407  * The method must return PID of the new process, a (positive??? ####) number
 408  * which fits into Lisp_Int. No return value indicates an error, the method
 409  * must signal an error instead.
 410  */
 411
 412 static void
 413 signal_cannot_launch (Lisp_Object image_file, DWORD err)
 414 {
 415   mswindows_set_errno (err);
 416   signal_simple_error_2 ("Error starting", image_file, lisp_strerror (errno));
 417 }
 418
 419 static int
 420 nt_create_process (Lisp_Process *p,
 421                    Lisp_Object *argv, int nargv,
 422                    Lisp_Object program, Lisp_Object cur_dir)
 423 {
 424   HANDLE hmyshove, hmyslurp, hprocin, hprocout, hprocerr;
 425   LPTSTR command_line;
 426   BOOL do_io, windowed;
 427   char *proc_env;
 428
 429   /* Find out whether the application is windowed or not */
 430   {
 431     /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most
 432        errors. This leads to bogus error message. */
 433     DWORD image_type;
 434     char *p = strrchr ((char *)XSTRING_DATA (program), '.');
 435     if (p != NULL &&
 436         (stricmp (p, ".exe") == 0 ||
 437          stricmp (p, ".com") == 0 ||
 438          stricmp (p, ".bat") == 0 ||
 439          stricmp (p, ".cmd") == 0))
 440       {
 441         image_type = SHGetFileInfo ((char *)XSTRING_DATA (program), 0,NULL,
 442                                     0, SHGFI_EXETYPE);
 443       }
 444     else
 445       {
 446         char progname[MAX_PATH];
 447         sprintf (progname, "%s.exe", (char *)XSTRING_DATA (program));
 448         image_type = SHGetFileInfo (progname, 0, NULL, 0, SHGFI_EXETYPE);
 449       }
 450     if (image_type == 0)
 451       signal_cannot_launch (program, (GetLastError () == ERROR_FILE_NOT_FOUND
 452                                       ? ERROR_BAD_FORMAT : GetLastError ()));
 453     windowed = HIWORD (image_type) != 0;
 454   }
 455
 456   /* Decide whether to do I/O on process handles, or just mark the
 457      process exited immediately upon successful launching. We do I/O if the
 458      process is a console one, or if it is windowed but windowed_process_io
 459      is non-zero */
 460   do_io = !windowed || windowed_process_io ;
 461
 462   if (do_io)
 463     {
 464       /* Create two unidirectional named pipes */
 465       HANDLE htmp;
 466       SECURITY_ATTRIBUTES sa;
 467
 468       sa.nLength = sizeof(sa);
 469       sa.bInheritHandle = TRUE;
 470       sa.lpSecurityDescriptor = NULL;
 471
 472       CreatePipe (&hprocin, &hmyshove, &sa, 0);
 473       CreatePipe (&hmyslurp, &hprocout, &sa, 0);
 474
 475       /* Duplicate the stdout handle for use as stderr */
 476       DuplicateHandle(GetCurrentProcess(), hprocout, GetCurrentProcess(), &hprocerr,
 477         0, TRUE, DUPLICATE_SAME_ACCESS);
 478
 479       /* Stupid Win32 allows to create a pipe with *both* ends either
 480          inheritable or not. We need process ends inheritable, and local
 481          ends not inheritable. */
 482       DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(), &htmp,
 483                        0, FALSE, DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
 484       hmyshove = htmp;
 485       DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(), &htmp,
 486                        0, FALSE, DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
 487       hmyslurp = htmp;
 488     }
 489
 490   /* Convert an argv vector into Win32 style command line by a call to
 491      lisp function `nt-quote-process-args' which see (in winnt.el)*/
 492   {
 493     int i;
 494     Lisp_Object args_or_ret = Qnil;
 495     struct gcpro gcpro1;
 496
 497     GCPRO1 (args_or_ret);
 498
 499     for (i = 0; i < nargv; ++i)
 500       args_or_ret = Fcons (*argv++, args_or_ret);
 501     args_or_ret = Fnreverse (args_or_ret);
 502     args_or_ret = Fcons (program, args_or_ret);
 503
 504     args_or_ret = call1 (Qnt_quote_process_args, args_or_ret);
 505
 506     if (!STRINGP (args_or_ret))
 507       /* Luser wrote his/her own clever version */
 508       error ("Bogus return value from `nt-quote-process-args'");
 509
 510     command_line = alloca_array (char, (XSTRING_LENGTH (program)
 511                                         + XSTRING_LENGTH (args_or_ret) + 2));
 512     strcpy (command_line, XSTRING_DATA (program));
 513     strcat (command_line, " ");
 514     strcat (command_line, XSTRING_DATA (args_or_ret));
 515
 516     UNGCPRO; /* args_or_ret */
 517   }
 518
 519   /* Set `proc_env' to a nul-separated array of the strings in
 520      Vprocess_environment terminated by 2 nuls.  */
 521
 522   {
 523     extern int compare_env (const char **strp1, const char **strp2);
 524     char **env;
 525     REGISTER Lisp_Object tem;
 526     REGISTER char **new_env;
 527     REGISTER int new_length = 0, i, new_space;
 528     char *penv;
 529
 530     for (tem = Vprocess_environment;
 531          (CONSP (tem)
 532           && STRINGP (XCAR (tem)));
 533          tem = XCDR (tem))
 534       new_length++;
 535
 536     /* new_length + 1 to include terminating 0.  */
 537     env = new_env = alloca_array (char *, new_length + 1);
 538
 539     /* Copy the Vprocess_environment strings into new_env.  */
 540     for (tem = Vprocess_environment;
 541          (CONSP (tem)
 542           && STRINGP (XCAR (tem)));
 543          tem = XCDR (tem))
 544       {
 545         char **ep = env;
 546         char *string = (char *) XSTRING_DATA (XCAR (tem));
 547         /* See if this string duplicates any string already in the env.
 548            If so, don't put it in.
 549            When an env var has multiple definitions,
 550            we keep the definition that comes first in process-environment.  */
 551         for (; ep != new_env; ep++)
 552           {
 553             char *p = *ep, *q = string;
 554             while (1)
 555               {
 556                 if (*q == 0)
 557                   /* The string is malformed; might as well drop it.  */
 558                   goto duplicate;
 559                 if (*q != *p)
 560                   break;
 561                 if (*q == '=')
 562                   goto duplicate;
 563                 p++, q++;
 564               }
 565           }
 566         *new_env++ = string;
 567       duplicate: ;
 568       }
 569     *new_env = 0;
 570
 571     /* Sort the environment variables */
 572     new_length = new_env - env;
 573     qsort (env, new_length, sizeof (char *), compare_env);
 574
 575     /* Work out how much space to allocate */
 576     new_space = 0;
 577     for (i = 0; i < new_length; i++)
 578       {
 579         new_space += strlen(env[i]) + 1;
 580       }
 581     new_space++;
 582
 583     /* Allocate space and copy variables into it */
 584     penv = proc_env = alloca(new_space);
 585     for (i = 0; i < new_length; i++)
 586       {
 587         strcpy(penv, env[i]);
 588         penv += strlen(env[i]) + 1;
 589       }
 590     *penv = 0;
 591   }
 592
 593   /* Create process */
 594   {
 595     STARTUPINFO si;
 596     PROCESS_INFORMATION pi;
 597     DWORD err;
 598
 599     xzero (si);
 600     si.dwFlags = STARTF_USESHOWWINDOW;
 601     si.wShowWindow = windowed ? SW_SHOWNORMAL : SW_HIDE;
 602     if (do_io)
 603       {
 604         si.hStdInput = hprocin;
 605         si.hStdOutput = hprocout;
 606         si.hStdError = hprocerr;
 607         si.dwFlags |= STARTF_USESTDHANDLES;
 608       }
 609
 610     err = (CreateProcess (NULL, command_line, NULL, NULL, TRUE,
 611                           CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP
 612                           | CREATE_SUSPENDED,
 613                           proc_env, (char *) XSTRING_DATA (cur_dir), &si, &pi)
 614            ? 0 : GetLastError ());
 615
 616     if (do_io)
 617       {
 618         /* These just have been inherited; we do not need a copy */
 619         CloseHandle (hprocin);
 620         CloseHandle (hprocout);
 621         CloseHandle (hprocerr);
 622       }
 623
 624     /* Handle process creation failure */
 625     if (err)
 626       {
 627         if (do_io)
 628           {
 629             CloseHandle (hmyshove);
 630             CloseHandle (hmyslurp);
 631           }
 632         signal_cannot_launch (program, GetLastError ());
 633       }
 634
 635     /* The process started successfully */
 636     if (do_io)
 637       {
 638         NT_DATA(p)->h_process = pi.hProcess;
 639         init_process_io_handles (p, (void*)hmyslurp, (void*)hmyshove, 0);
 640       }
 641     else
 642       {
 643         /* Indicate as if the process has exited immediately. */
 644         p->status_symbol = Qexit;
 645         CloseHandle (pi.hProcess);
 646       }
 647
 648     ResumeThread (pi.hThread);
 649     CloseHandle (pi.hThread);
 650
 651     /* Remember to enable child signals later if this is not a windowed
 652        app.  Can't do it right now because that screws up the MKS Toolkit
 653        shell. */
 654     if (!windowed)
 655       {
 656         NT_DATA(p)->need_enable_child_signals = 10;
 657         kick_status_notify ();
 658       }
 659
 660     return ((int)pi.dwProcessId);
 661   }
 662 }
 663
 664 /*
 665  * This method is called to update status fields of the process
 666  * structure. If the process has not existed, this method is expected
 667  * to do nothing.
 668  *
 669  * The method is called only for real child processes.
 670  */
 671
 672 static void
 673 nt_update_status_if_terminated (Lisp_Process* p)
 674 {
 675   DWORD exit_code;
 676
 677   if (NT_DATA(p)->need_enable_child_signals > 1)
 678     {
 679       NT_DATA(p)->need_enable_child_signals -= 1;
 680       kick_status_notify ();
 681     }
 682   else if (NT_DATA(p)->need_enable_child_signals == 1)
 683     {
 684       enable_child_signals(NT_DATA(p)->h_process);
 685       NT_DATA(p)->need_enable_child_signals = 0;
 686     }
 687
 688   if (GetExitCodeProcess (NT_DATA(p)->h_process, &exit_code)
 689       && exit_code != STILL_ACTIVE)
 690     {
 691       p->tick++;
 692       p->core_dumped = 0;
 693       /* The exit code can be a code returned by process, or an
 694          NTSTATUS value. We cannot accurately handle the latter since
 695          it is a full 32 bit integer */
 696       if (exit_code & 0xC0000000)
 697         {
 698           p->status_symbol = Qsignal;
 699           p->exit_code = exit_code & 0x1FFFFFFF;
 700         }
 701       else
 702         {
 703           p->status_symbol = Qexit;
 704           p->exit_code = exit_code;
 705         }
 706     }
 707 }
 708
 709 /*
 710  * Stuff the entire contents of LSTREAM to the process output pipe
 711  */
 712
 713 /* #### If only this function could be somehow merged with
 714    unix_send_process... */
 715
 716 static void
 717 nt_send_process (Lisp_Object proc, struct lstream* lstream)
 718 {
 719   volatile Lisp_Object vol_proc = proc;
 720   Lisp_Process *volatile p = XPROCESS (proc);
 721
 722   /* use a reasonable-sized buffer (somewhere around the size of the
 723      stream buffer) so as to avoid inundating the stream with blocked
 724      data. */
 725   Bufbyte chunkbuf[128];
 726   Bytecount chunklen;
 727
 728   while (1)
 729     {
 730       ssize_t writeret;
 731
 732       chunklen = Lstream_read (lstream, chunkbuf, 128);
 733       if (chunklen <= 0)
 734         break; /* perhaps should abort() if < 0?
 735                   This should never happen. */
 736
 737       /* Lstream_write() will never successfully write less than the
 738          amount sent in.  In the worst case, it just buffers the
 739          unwritten data. */
 740       writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM(p)), chunkbuf,
 741                                 chunklen);
 742       Lstream_flush (XLSTREAM (DATA_OUTSTREAM(p)));
 743       if (writeret < 0)
 744         {
 745           p->status_symbol = Qexit;
 746           p->exit_code = ERROR_BROKEN_PIPE;
 747           p->core_dumped = 0;
 748           p->tick++;
 749           process_tick++;
 750           deactivate_process (*((Lisp_Object *) (&vol_proc)));
 751           error ("Broken pipe error sending to process %s; closed it",
 752                  XSTRING_DATA (p->name));
 753         }
 754
 755       {
 756         int wait_ms = 25;
 757         while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream)))
 758           {
 759             /* Buffer is full.  Wait, accepting input; that may allow
 760                the program to finish doing output and read more.  */
 761             Faccept_process_output (Qnil, Qzero, make_int (wait_ms));
 762             Lstream_flush (XLSTREAM (p->pipe_outstream));
 763             wait_ms = min (1000, 2 * wait_ms);
 764           }
 765       }
 766     }
 767 }
 768
 769 /*
 770  * Send a signal number SIGNO to PROCESS.
 771  * CURRENT_GROUP means send to the process group that currently owns
 772  * the terminal being used to communicate with PROCESS.
 773  * This is used for various commands in shell mode.
 774  * If NOMSG is zero, insert signal-announcements into process's buffers
 775  * right away.
 776  *
 777  * If we can, we try to signal PROCESS by sending control characters
 778  * down the pty.  This allows us to signal inferiors who have changed
 779  * their uid, for which killpg would return an EPERM error.
 780  *
 781  * The method signals an error if the given SIGNO is not valid
 782  */
 783
 784 static void
 785 nt_kill_child_process (Lisp_Object proc, int signo,
 786                        int current_group, int nomsg)
 787 {
 788   Lisp_Process *p = XPROCESS (proc);
 789
 790   /* Enable child signals if necessary.  This may lose the first
 791      but it's better than nothing. */
 792   if (NT_DATA(p)->need_enable_child_signals > 0)
 793     {
 794       enable_child_signals(NT_DATA(p)->h_process);
 795       NT_DATA(p)->need_enable_child_signals = 0;
 796     }
 797
 798   /* Signal error if SIGNO cannot be sent */
 799   validate_signal_number (signo);
 800
 801   /* Send signal */
 802   if (!send_signal (NT_DATA(p)->h_process, signo))
 803     error ("Cannot send signal to process");
 804 }
 805
 806 /*
 807  * Kill any process in the system given its PID.
 808  *
 809  * Returns zero if a signal successfully sent, or
 810  * negative number upon failure
 811  */
 812 static int
 813 nt_kill_process_by_pid (int pid, int signo)
 814 {
 815   HANDLE h_process;
 816   int send_result;
 817
 818   /* Signal error if SIGNO cannot be sent */
 819   validate_signal_number (signo);
 820
 821   /* Try to open the process with required privileges */
 822   h_process = OpenProcess (PROCESS_CREATE_THREAD
 823                            | PROCESS_QUERY_INFORMATION
 824                            | PROCESS_VM_OPERATION
 825                            | PROCESS_VM_WRITE,
 826                            FALSE, pid);
 827   if (h_process == NULL)
 828     return -1;
 829
 830   send_result = send_signal (h_process, signo);
 831
 832   CloseHandle (h_process);
 833
 834   return send_result ? 0 : -1;
 835 }
 836 \f
 837 /*-----------------------------------------------------------------------*/
 838 /* Sockets connections                                                   */
 839 /*-----------------------------------------------------------------------*/
 840 #ifdef HAVE_SOCKETS
 841
 842 /* #### Hey MS, how long Winsock 2 for '95 will be in beta? */
 843
 844 #define SOCK_TIMER_ID 666
 845 #define XM_SOCKREPLY (WM_USER + 666)
 846
 847 static int
 848 get_internet_address (Lisp_Object host, struct sockaddr_in *address,
 849                       Error_behavior errb)
 850 {
 851   char buf [MAXGETHOSTSTRUCT];
 852   HWND hwnd;
 853   HANDLE hasync;
 854   int success = 0;
 855
 856   address->sin_family = AF_INET;
 857
 858   /* First check if HOST is already a numeric address */
 859   {
 860     unsigned long inaddr = inet_addr (XSTRING_DATA (host));
 861     if (inaddr != INADDR_NONE)
 862       {
 863         address->sin_addr.s_addr = inaddr;
 864         return 1;
 865       }
 866   }
 867
 868   /* Create a window which will receive completion messages */
 869   hwnd = CreateWindow ("STATIC", NULL, WS_OVERLAPPED, 0, 0, 1, 1,
 870                        NULL, NULL, NULL, NULL);
 871   assert (hwnd);
 872
 873   /* Post name resolution request */
 874   hasync = WSAAsyncGetHostByName (hwnd, XM_SOCKREPLY, XSTRING_DATA (host),
 875                                   buf, sizeof (buf));
 876   if (hasync == NULL)
 877     goto done;
 878
 879   /* Set a timer to poll for quit every 250 ms */
 880   SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL);
 881
 882   while (1)
 883     {
 884       MSG msg;
 885       GetMessage (&msg, hwnd, 0, 0);
 886       if (msg.message == XM_SOCKREPLY)
 887         {
 888           /* Ok, got an answer */
 889           if (WSAGETASYNCERROR(msg.lParam) == NO_ERROR)
 890             success = 1;
 891           else
 892             {
 893               warn_when_safe(Qstream, Qwarning,
 894                              "cannot get IP address for host \"%s\"",
 895                              XSTRING_DATA (host));
 896             }
 897           goto done;
 898         }
 899       else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID)
 900         {
 901           if (QUITP)
 902             {
 903               WSACancelAsyncRequest (hasync);
 904               KillTimer (hwnd, SOCK_TIMER_ID);
 905               DestroyWindow (hwnd);
 906               REALLY_QUIT;
 907             }
 908         }
 909       DispatchMessage (&msg);
 910     }
 911
 912  done:
 913   KillTimer (hwnd, SOCK_TIMER_ID);
 914   DestroyWindow (hwnd);
 915   if (success)
 916     {
 917       /* BUF starts with struct hostent */
 918       struct hostent* he = (struct hostent*) buf;
 919       address->sin_addr.s_addr = *(unsigned long*)he->h_addr_list[0];
 920     }
 921   return success;
 922 }
 923
 924 static Lisp_Object
 925 nt_canonicalize_host_name (Lisp_Object host)
 926 {
 927   struct sockaddr_in address;
 928
 929   if (!get_internet_address (host, &address, ERROR_ME_NOT))
 930     return host;
 931
 932   if (address.sin_family == AF_INET)
 933     return build_string (inet_ntoa (address.sin_addr));
 934   else
 935     return host;
 936 }
 937
 938 /* open a TCP network connection to a given HOST/SERVICE.  Treated
 939    exactly like a normal process when reading and writing.  Only
 940    differences are in status display and process deletion.  A network
 941    connection has no PID; you cannot signal it.  All you can do is
 942    deactivate and close it via delete-process */
 943
 944 static void
 945 nt_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service,
 946                         Lisp_Object protocol, void** vinfd, void** voutfd)
 947 {
 948   struct sockaddr_in address;
 949   SOCKET s;
 950   int port;
 951   int retval;
 952
 953   CHECK_STRING (host);
 954
 955   if (!EQ (protocol, Qtcp))
 956     error ("Unsupported protocol \"%s\"",
 957            string_data (symbol_name (XSYMBOL (protocol))));
 958
 959   if (INTP (service))
 960     port = htons ((unsigned short) XINT (service));
 961   else
 962     {
 963       struct servent *svc_info;
 964       CHECK_STRING (service);
 965       svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp");
 966       if (svc_info == 0)
 967         error ("Unknown service \"%s\"", XSTRING_DATA (service));
 968       port = svc_info->s_port;
 969     }
 970
 971   get_internet_address (host, &address, ERROR_ME);
 972   address.sin_port = port;
 973
 974   s = socket (address.sin_family, SOCK_STREAM, 0);
 975   if (s < 0)
 976     report_file_error ("error creating socket", list1 (name));
 977
 978   /* We don't want to be blocked on connect */
 979   {
 980     unsigned long nonblock = 1;
 981     ioctlsocket (s, FIONBIO, &nonblock);
 982   }
 983
 984   retval = connect (s, (struct sockaddr *) &address, sizeof (address));
 985   if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK)
 986     goto connect_failed;
 987   /* Wait while connection is established */
 988   while (1)
 989     {
 990       fd_set fdset;
 991       struct timeval tv;
 992       int nsel;
 993
 994       if (QUITP)
 995         {
 996           closesocket (s);
 997           REALLY_QUIT;
 998         }
 999
1000       /* Poll for quit every 250 ms */
1001       tv.tv_sec = 0;
1002       tv.tv_usec = 250 * 1000;
1003
1004       FD_ZERO (&fdset);
1005       FD_SET (s, &fdset);
1006       nsel = select (0, NULL, &fdset, &fdset, &tv);
1007
1008       if (nsel > 0)
1009         {
1010           /* Check: was connection successful or not? */
1011           tv.tv_usec = 0;
1012           nsel = select (0, NULL, NULL, &fdset, &tv);
1013           if (nsel > 0)
1014             goto connect_failed;
1015           else
1016             break;
1017         }
1018     }
1019
1020   /* We are connected at this point */
1021   *vinfd = (void*)s;
1022   DuplicateHandle (GetCurrentProcess(), (HANDLE)s,
1023                    GetCurrentProcess(), (LPHANDLE)voutfd,
1024                    0, FALSE, DUPLICATE_SAME_ACCESS);
1025   return;
1026
1027  connect_failed:
1028   closesocket (s);
1029   if (INTP (service)) {
1030     warn_when_safe(Qstream, Qwarning,
1031                    "failure to open network stream to host \"%s\" for service \"%d\"",
1032                    XSTRING_DATA (host),
1033                    (unsigned short) XINT (service));
1034   }
1035   else {
1036     warn_when_safe(Qstream, Qwarning,
1037                    "failure to open network stream to host \"%s\" for service \"%s\"",
1038                    XSTRING_DATA (host),
1039                    XSTRING_DATA (service));
1040   }
1041   report_file_error ("connection failed", list2 (host, name));
1042 }
1043
1044 #endif
1045 \f
1046 /*-----------------------------------------------------------------------*/
1047 /* Initialization                                                        */
1048 /*-----------------------------------------------------------------------*/
1049
1050 void
1051 process_type_create_nt (void)
1052 {
1053   PROCESS_HAS_METHOD (nt, alloc_process_data);
1054   PROCESS_HAS_METHOD (nt, finalize_process_data);
1055   PROCESS_HAS_METHOD (nt, init_process);
1056   PROCESS_HAS_METHOD (nt, create_process);
1057   PROCESS_HAS_METHOD (nt, update_status_if_terminated);
1058   PROCESS_HAS_METHOD (nt, send_process);
1059   PROCESS_HAS_METHOD (nt, kill_child_process);
1060   PROCESS_HAS_METHOD (nt, kill_process_by_pid);
1061 #ifdef HAVE_SOCKETS
1062   PROCESS_HAS_METHOD (nt, canonicalize_host_name);
1063   PROCESS_HAS_METHOD (nt, open_network_stream);
1064 #ifdef HAVE_MULTICAST
1065 #error I won't do this until '95 has winsock2
1066   PROCESS_HAS_METHOD (nt, open_multicast_group);
1067 #endif
1068 #endif
1069 }
1070
1071 void
1072 syms_of_process_nt (void)
1073 {
1074   defsymbol (&Qnt_quote_process_args, "nt-quote-process-args");
1075 }
1076
1077 void
1078 vars_of_process_nt (void)
1079 {
1080 }