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