1 /* Copyright (C) 2001, 2006, 2008, 2016 Free Software Foundation, Inc.
2 *
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
7 *
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
12 *
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16 * 02110-1301 USA
17 */
18
19 #ifdef HAVE_CONFIG_H
20 # include <config.h>
21 #endif
22
23 #include "libguile/__scm.h"
24
25 # define WIN32_LEAN_AND_MEAN
26 #include <windows.h>
27 #include <c-strcase.h>
28 #include <process.h>
29 #include <stdio.h>
30 #include <stdlib.h>
31 #include <string.h>
32 #include <errno.h>
33 #include <signal.h>
34 #include <io.h>
35 #include <fcntl.h>
36
37 #include "posix-w32.h"
38 #include "libguile/gc.h" /* for scm_*alloc, scm_strdup */
39 #include "libguile/threads.h" /* for scm_i_scm_pthread_mutex_lock */
40
41 /*
42 * Get name and information about current kernel.
43 */
44 int
uname(struct utsname * uts)45 uname (struct utsname *uts)
46 {
47 enum { WinNT, Win95, Win98, WinUnknown };
48 OSVERSIONINFO osver;
49 SYSTEM_INFO sysinfo;
50 DWORD sLength;
51 DWORD os = WinUnknown;
52
53 memset (uts, 0, sizeof (*uts));
54
55 osver.dwOSVersionInfoSize = sizeof (osver);
56 GetVersionEx (&osver);
57 GetSystemInfo (&sysinfo);
58
59 switch (osver.dwPlatformId)
60 {
61 case VER_PLATFORM_WIN32_NT: /* NT, Windows 2000 or Windows XP */
62 if (osver.dwMajorVersion == 4)
63 strcpy (uts->sysname, "Windows NT4x"); /* NT4x */
64 else if (osver.dwMajorVersion <= 3)
65 strcpy (uts->sysname, "Windows NT3x"); /* NT3x */
66 else if (osver.dwMajorVersion == 5 && osver.dwMinorVersion < 1)
67 strcpy (uts->sysname, "Windows 2000"); /* 2k */
68 else if (osver.dwMajorVersion < 6)
69 strcpy (uts->sysname, "Windows XP"); /* XP */
70 else if (osver.dwMajorVersion == 6)
71 {
72 if (osver.dwMinorVersion < 1)
73 strcpy (uts->sysname, "Windows Vista"); /* Vista */
74 else if (osver.dwMinorVersion < 2)
75 strcpy (uts->sysname, "Windows 7"); /* Windows 7 */
76 else if (osver.dwMinorVersion < 3)
77 strcpy (uts->sysname, "Windows 8"); /* Windows 8 */
78 else if (osver.dwMinorVersion < 4)
79 strcpy (uts->sysname, "Windows 8.1"); /* Windows 8.1 */
80 }
81 else if (osver.dwMajorVersion >= 10)
82 strcpy (uts->sysname, "Windows 10 or later"); /* Windows 10 and later */
83 os = WinNT;
84 break;
85
86 case VER_PLATFORM_WIN32_WINDOWS: /* Win95, Win98 or WinME */
87 if ((osver.dwMajorVersion > 4) ||
88 ((osver.dwMajorVersion == 4) && (osver.dwMinorVersion > 0)))
89 {
90 if (osver.dwMinorVersion >= 90)
91 strcpy (uts->sysname, "Windows ME"); /* ME */
92 else
93 strcpy (uts->sysname, "Windows 98"); /* 98 */
94 os = Win98;
95 }
96 else
97 {
98 strcpy (uts->sysname, "Windows 95"); /* 95 */
99 os = Win95;
100 }
101 break;
102
103 case VER_PLATFORM_WIN32s: /* Windows 3.x */
104 strcpy (uts->sysname, "Windows");
105 break;
106 }
107
108 sprintf (uts->version, "%ld.%02ld",
109 osver.dwMajorVersion, osver.dwMinorVersion);
110
111 if (osver.szCSDVersion[0] != '\0' &&
112 (strlen (osver.szCSDVersion) + strlen (uts->version) + 1) <
113 sizeof (uts->version))
114 {
115 strcat (uts->version, " ");
116 strcat (uts->version, osver.szCSDVersion);
117 }
118
119 sprintf (uts->release, "build %ld", osver.dwBuildNumber & 0xFFFF);
120
121 switch (sysinfo.wProcessorArchitecture)
122 {
123 case PROCESSOR_ARCHITECTURE_PPC:
124 strcpy (uts->machine, "ppc");
125 break;
126 case PROCESSOR_ARCHITECTURE_ALPHA:
127 strcpy (uts->machine, "alpha");
128 break;
129 case PROCESSOR_ARCHITECTURE_MIPS:
130 strcpy (uts->machine, "mips");
131 break;
132 case PROCESSOR_ARCHITECTURE_IA64:
133 strcpy (uts->machine, "ia64");
134 break;
135 case PROCESSOR_ARCHITECTURE_INTEL:
136 /*
137 * dwProcessorType is only valid in Win95 and Win98 and WinME
138 * wProcessorLevel is only valid in WinNT
139 */
140 switch (os)
141 {
142 case Win95:
143 case Win98:
144 switch (sysinfo.dwProcessorType)
145 {
146 case PROCESSOR_INTEL_386:
147 case PROCESSOR_INTEL_486:
148 case PROCESSOR_INTEL_PENTIUM:
149 sprintf (uts->machine, "i%ld", sysinfo.dwProcessorType);
150 break;
151 default:
152 strcpy (uts->machine, "i386");
153 break;
154 }
155 break;
156 case WinNT:
157 sprintf (uts->machine, "i%d86", sysinfo.wProcessorLevel);
158 break;
159 default:
160 strcpy (uts->machine, "unknown");
161 break;
162 }
163 break;
164 case PROCESSOR_ARCHITECTURE_AMD64:
165 strcpy (uts->machine, "x86_64");
166 break;
167 default:
168 strcpy (uts->machine, "unknown");
169 break;
170 }
171
172 sLength = sizeof (uts->nodename) - 1;
173 GetComputerName (uts->nodename, &sLength);
174 return 0;
175 }
176
177 /* Utility functions for maintaining the list of subprocesses launched
178 by Guile. */
179
180 struct proc_record {
181 DWORD pid;
182 HANDLE handle;
183 };
184
185 static struct proc_record *procs;
186 static ptrdiff_t proc_size;
187
188 /* Find the process slot that corresponds to PID. Return the index of
189 the slot, or -1 if not found. */
190 static ptrdiff_t
find_proc(pid_t pid)191 find_proc (pid_t pid)
192 {
193 ptrdiff_t found = -1, i;
194
195 for (i = 0; i < proc_size; i++)
196 {
197 if (procs[i].pid == pid && procs[i].handle != INVALID_HANDLE_VALUE)
198 found = i;
199 }
200
201 return found;
202 }
203
204 /* Return the process handle corresponding to its PID. If not found,
205 return invalid handle value. */
206 static HANDLE
proc_handle(pid_t pid)207 proc_handle (pid_t pid)
208 {
209 ptrdiff_t idx = find_proc (pid);
210
211 if (idx < 0)
212 return INVALID_HANDLE_VALUE;
213 return procs[idx].handle;
214 }
215
216 /* Store a process record in the procs[] array. */
217 static void
record_proc(pid_t proc_pid,HANDLE proc_handle)218 record_proc (pid_t proc_pid, HANDLE proc_handle)
219 {
220 ptrdiff_t i;
221
222 /* Find a vacant slot. */
223 for (i = 0; i < proc_size; i++)
224 {
225 if (procs[i].handle == INVALID_HANDLE_VALUE)
226 break;
227 }
228
229 /* If no vacant slot, enlarge the array. */
230 if (i == proc_size)
231 {
232 proc_size++;
233 procs = scm_realloc (procs, proc_size * sizeof(procs[0]));
234 }
235
236 /* Store the process data. */
237 procs[i].pid = proc_pid;
238 procs[i].handle = proc_handle;
239 }
240
241 /* Delete a process record for process PID. */
242 static void
delete_proc(pid_t pid)243 delete_proc (pid_t pid)
244 {
245 ptrdiff_t idx = find_proc (pid);
246
247 if (0 <= idx && idx < proc_size)
248 procs[idx].handle = INVALID_HANDLE_VALUE;
249 }
250
251 /* Run a child process with redirected standard handles, without
252 redirecting standard handles of the parent. This is required in
253 multithreaded programs, where redirecting a standard handle affects
254 all threads. */
255
256 /* Prepare a possibly redirected file handle to be passed to a child
257 process. The handle is for the file/device open on file descriptor
258 FD; if FD is invalid, use the null device instead.
259
260 USE_STD non-zero means we have been passed the descriptor used by
261 the parent.
262
263 ACCESS is the Windows access mode for opening the null device.
264
265 Returns the Win32 handle to be passed to CreateProcess. */
266 static HANDLE
prepare_child_handle(int fd,int use_std,DWORD access)267 prepare_child_handle (int fd, int use_std, DWORD access)
268 {
269 HANDLE htem, hret;
270 DWORD err = 0;
271
272 /* Start with the descriptor, if specified by the caller and valid,
273 otherwise open the null device. */
274 if (fd < 0)
275 htem = INVALID_HANDLE_VALUE;
276 else
277 htem = (HANDLE)_get_osfhandle (fd);
278
279 /* Duplicate the handle and make it inheritable. */
280 if (DuplicateHandle (GetCurrentProcess (),
281 htem,
282 GetCurrentProcess (),
283 &hret,
284 0,
285 TRUE,
286 DUPLICATE_SAME_ACCESS) == FALSE)
287 {
288 /* If the original standard handle was invalid (happens, e.g.,
289 in GUI programs), open the null device instead. */
290 if ((err = GetLastError ()) == ERROR_INVALID_HANDLE
291 && use_std)
292 {
293 htem = CreateFile ("NUL", access,
294 FILE_SHARE_READ | FILE_SHARE_WRITE, NULL,
295 OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
296 if (htem != INVALID_HANDLE_VALUE
297 && DuplicateHandle (GetCurrentProcess (),
298 htem,
299 GetCurrentProcess (),
300 &hret,
301 0,
302 TRUE,
303 DUPLICATE_SAME_ACCESS) == FALSE)
304 {
305 err = GetLastError ();
306 CloseHandle (htem);
307 hret = INVALID_HANDLE_VALUE;
308 }
309 }
310 }
311
312 if (hret == INVALID_HANDLE_VALUE)
313 {
314 switch (err)
315 {
316 case ERROR_NO_MORE_FILES:
317 errno = EMFILE;
318 break;
319 case ERROR_INVALID_HANDLE:
320 default:
321 errno = EBADF;
322 break;
323 }
324 }
325
326 return hret;
327 }
328
329 /* A comparison function for sorting the environment. */
330 static int
compenv(const void * a1,const void * a2)331 compenv (const void *a1, const void *a2)
332 {
333 return stricmp (*((char**)a1), *((char**)a2));
334 }
335
336 /* Convert the program's 'environ' array to a block of environment
337 variables suitable to be passed to CreateProcess. This is needed
338 to ensure the child process inherits the up-to-date environment of
339 the parent, including any variables inserted by the parent. */
340 static void
prepare_envblk(char ** envp,char ** envblk)341 prepare_envblk (char **envp, char **envblk)
342 {
343 char **tmp;
344 int size_needed;
345 int envcnt;
346 char *ptr;
347
348 for (envcnt = 0; envp[envcnt]; envcnt++)
349 ;
350
351 tmp = scm_calloc ((envcnt + 1) * sizeof (*tmp));
352
353 for (envcnt = size_needed = 0; envp[envcnt]; envcnt++)
354 {
355 tmp[envcnt] = envp[envcnt];
356 size_needed += strlen (envp[envcnt]) + 1;
357 }
358 size_needed++;
359
360 /* Windows likes its environment variables sorted. */
361 qsort ((void *) tmp, (size_t) envcnt, sizeof (char *), compenv);
362
363 /* CreateProcess needs the environment block as a linear array,
364 where each variable is terminated by a null character, and the
365 last one is terminated by 2 null characters. */
366 ptr = *envblk = scm_calloc (size_needed);
367
368 for (envcnt = 0; tmp[envcnt]; envcnt++)
369 {
370 strcpy (ptr, tmp[envcnt]);
371 ptr += strlen (tmp[envcnt]) + 1;
372 }
373
374 free (tmp);
375 }
376
377 /* Find an executable PROGRAM on PATH, return result in malloc'ed
378 storage. If PROGRAM is /bin/sh, and no sh.exe was found on PATH,
379 fall back on the Windows shell and set BIN_SH_REPLACED to non-zero. */
380 static char *
lookup_cmd(const char * program,int * bin_sh_replaced)381 lookup_cmd (const char *program, int *bin_sh_replaced)
382 {
383 static const char *extensions[] = {
384 ".exe", ".cmd", ".bat", "", ".com", NULL
385 };
386 int bin_sh_requested = 0;
387 char *path, *dir, *sep;
388 char abs_name[MAX_PATH];
389 DWORD abs_namelen = 0;
390
391 /* If they ask for the Unix system shell, try to find it on PATH. */
392 if (c_strcasecmp (program, "/bin/sh") == 0)
393 {
394 bin_sh_requested = 1;
395 program = "sh.exe";
396 }
397
398 /* If PROGRAM includes leading directories, the caller already did
399 our job. */
400 if (strchr (program, '/') != NULL
401 || strchr (program, '\\') != NULL)
402 return scm_strdup (program);
403
404 /* Note: It is OK for getenv below to return NULL -- in that case,
405 SearchPath will search in the directories whose list is specified
406 by the system Registry. */
407 path = getenv ("PATH");
408 if (!path) /* shouldn't happen, really */
409 path = ".";
410 dir = sep = path = strdup (path);
411 for ( ; sep && *sep; dir = sep + 1)
412 {
413 int i;
414
415 sep = strpbrk (dir, ";");
416 if (sep == dir) /* two or more ;'s in a row */
417 continue;
418 if (sep)
419 *sep = '\0';
420 for (i = 0; extensions[i]; i++)
421 {
422 abs_namelen = SearchPath (dir, program, extensions[i],
423 MAX_PATH, abs_name, NULL);
424 if (0 < abs_namelen && abs_namelen <= MAX_PATH) /* found! */
425 break;
426 }
427 if (extensions[i]) /* found! */
428 break;
429 if (sep)
430 *sep = ';';
431 }
432
433 free (path);
434
435 /* If they asked for /bin/sh and we didn't find it, fall back on the
436 default Windows shell. */
437 if (abs_namelen <= 0 && bin_sh_requested)
438 {
439 const char *shell = getenv ("ComSpec");
440
441 if (!shell)
442 shell = "C:\\Windows\\system32\\cmd.exe";
443
444 *bin_sh_replaced = 1;
445 strcpy (abs_name, shell);
446 abs_namelen = strlen (abs_name);
447 }
448
449 /* If not found, return the original PROGRAM name. */
450 if (abs_namelen <= 0 || abs_namelen > MAX_PATH)
451 return scm_strdup (program);
452
453 return scm_strndup (abs_name, abs_namelen);
454 }
455
456 /* Concatenate command-line arguments in argv[] into a single
457 command-line string, while quoting arguments as needed. The result
458 is malloc'ed. */
459 static char *
prepare_cmdline(const char * cmd,const char * const * argv,int bin_sh_replaced)460 prepare_cmdline (const char *cmd, const char * const *argv, int bin_sh_replaced)
461 {
462 /* These characters should include anything that is special to _any_
463 program, including both Windows and Unixy shells, and the
464 widlcard expansion in startup code of a typical Windows app. */
465 const char need_quotes[] = " \t#;\"\'*?[]&|<>(){}$`^";
466 size_t cmdlen = 1; /* for terminating null */
467 char *cmdline = scm_malloc (cmdlen);
468 char *dst = cmdline;
469 int cmd_exe_quoting = 0;
470 int i;
471 const char *p;
472
473 /* Are we constructing a command line for cmd.exe? */
474 if (bin_sh_replaced)
475 cmd_exe_quoting = 1;
476 else
477 {
478 for (p = cmd + strlen (cmd);
479 p > cmd && p[-1] != '/' && p[-1] != '\\' && p[-1] != ':';
480 p--)
481 ;
482 if (c_strcasecmp (p, "cmd.exe") == 0
483 || c_strcasecmp (p, "cmd") == 0)
484 cmd_exe_quoting = 1;
485 }
486
487 /* Initialize the command line to empty. */
488 *dst = '\0';
489
490 /* Append arguments, if any, from argv[]. */
491 for (i = 0; argv[i]; i++)
492 {
493 const char *src = argv[i];
494 size_t len;
495 int quote_this = 0, n_backslashes = 0;
496 int j;
497
498 /* Append the blank separator. We don't do that for argv[0]
499 because that is the command name (will end up in child's
500 argv[0]), and is only recognized as such if there're no
501 blanks before it. */
502 if (i > 0)
503 *dst++ = ' ';
504 len = dst - cmdline;
505
506 /* How much space is required for this argument? */
507 cmdlen += strlen (argv[i]) + 1; /* 1 for a blank separator */
508 /* cmd.exe needs a different style of quoting: all the arguments
509 beyond the /c switch are enclosed in an extra pair of quotes,
510 and not otherwise quoted/escaped. */
511 if (cmd_exe_quoting)
512 {
513 if (i == 2)
514 cmdlen += 2;
515 }
516 else if (strpbrk (argv[i], need_quotes))
517 {
518 quote_this = 1;
519 cmdlen += 2;
520 for ( ; *src; src++)
521 {
522 /* An embedded quote needs to be escaped by a backslash.
523 Any backslashes immediately preceding that quote need
524 each one to be escaped by another backslash. */
525 if (*src == '\"')
526 cmdlen += n_backslashes + 1;
527 if (*src == '\\')
528 n_backslashes++;
529 else
530 n_backslashes = 0;
531 }
532 /* If the closing quote we will add is preceded by
533 backslashes, those backslashes need to be escaped. */
534 cmdlen += n_backslashes;
535 }
536
537 /* Enlarge the command-line string as needed. */
538 cmdline = scm_realloc (cmdline, cmdlen);
539 dst = cmdline + len;
540
541 if (i == 0
542 && c_strcasecmp (argv[0], "/bin/sh") == 0
543 && bin_sh_replaced)
544 {
545 strcpy (dst, "cmd.exe");
546 dst += sizeof ("cmd.exe") - 1;
547 continue;
548 }
549 if (i == 1 && bin_sh_replaced && strcmp (argv[1], "-c") == 0)
550 {
551 *dst++ = '/';
552 *dst++ = 'c';
553 *dst = '\0';
554 continue;
555 }
556
557 /* Add this argument, possibly quoted, to the command line. */
558 if (quote_this || (i == 2 && cmd_exe_quoting))
559 *dst++ = '\"';
560 for (src = argv[i]; *src; src++)
561 {
562 if (quote_this)
563 {
564 if (*src == '\"')
565 for (j = n_backslashes + 1; j > 0; j--)
566 *dst++ = '\\';
567 if (*src == '\\')
568 n_backslashes++;
569 else
570 n_backslashes = 0;
571 }
572 *dst++ = *src;
573 }
574 if (quote_this)
575 {
576 for (j = n_backslashes; j > 0; j--)
577 *dst++ = '\\';
578 *dst++ = '\"';
579 }
580 *dst = '\0';
581 }
582
583 if (cmd_exe_quoting && i > 2)
584 {
585 /* One extra slot was already reserved when we enlarged cmdlen
586 by 2 in the "if (cmd_exe_quoting)" clause above. So we can
587 safely append a closing quote. */
588 *dst++ = '\"';
589 *dst = '\0';
590 }
591
592 return cmdline;
593 }
594
595 /* Start a child process running the program in EXEC_FILE with its
596 standard input and output optionally redirected to a pipe. ARGV is
597 the array of command-line arguments to pass to the child. P2C and
598 C2P are 2 pipes for communicating with the child, and ERRFD is the
599 standard error file descriptor to be inherited by the child.
600 READING and WRITING, if non-zero, mean that the corresponding pipe
601 will be used.
602
603 Return the PID of the child process, or -1 if couldn't start a
604 process. */
605 pid_t
start_child(const char * exec_file,char ** argv,int reading,int c2p[2],int writing,int p2c[2],int infd,int outfd,int errfd)606 start_child (const char *exec_file, char **argv,
607 int reading, int c2p[2], int writing, int p2c[2],
608 int infd, int outfd, int errfd)
609 {
610 HANDLE hin = INVALID_HANDLE_VALUE, hout = INVALID_HANDLE_VALUE;
611 HANDLE herr = INVALID_HANDLE_VALUE;
612 STARTUPINFO si;
613 char *env_block = NULL;
614 char *cmdline = NULL;
615 PROCESS_INFORMATION pi;
616 char *progfile, *p;
617 int errno_save;
618 intptr_t pid;
619 int bin_sh_replaced = 0;
620
621 if (!reading)
622 c2p[1] = outfd;
623 if (!writing)
624 p2c[0] = infd;
625
626 /* Prepare standard handles to be passed to the child process. */
627 hin = prepare_child_handle (p2c[0], !writing, GENERIC_READ);
628 if (hin == INVALID_HANDLE_VALUE)
629 return -1;
630 hout = prepare_child_handle (c2p[1], !reading, GENERIC_WRITE);
631 if (hout == INVALID_HANDLE_VALUE)
632 return -1;
633 herr = prepare_child_handle (errfd, 1, GENERIC_WRITE);
634 if (herr == INVALID_HANDLE_VALUE)
635 return -1;
636
637 /* Make sure the parent side of both pipes is not inherited. This
638 is required because gnulib's 'pipe' creates pipes whose both ends
639 are inheritable, which is traditional on Posix (where pipe
640 descriptors are implicitly duplicated by 'fork'), but wrong on
641 Windows (where pipe handles need to be explicitly
642 duplicated). */
643 if (writing)
644 SetHandleInformation ((HANDLE)_get_osfhandle (p2c[1]),
645 HANDLE_FLAG_INHERIT, 0);
646 if (reading)
647 {
648 SetHandleInformation ((HANDLE)_get_osfhandle (c2p[0]),
649 HANDLE_FLAG_INHERIT, 0);
650 /* Gnulib's 'pipe' opens the pipe in binary mode, but we don't
651 want to read text-mode input of subprocesses in binary more,
652 because then we will get the ^M (a.k.a. "CR") characters we
653 don't expect. */
654 _setmode (c2p[0], _O_TEXT);
655 }
656
657 /* Set up the startup info for the child, using the parent's as the
658 starting point, and specify in it the redirected handles. */
659 GetStartupInfo (&si);
660 si.dwFlags = STARTF_USESTDHANDLES;
661 si.lpReserved = 0;
662 si.cbReserved2 = 0;
663 si.lpReserved2 = 0;
664 si.hStdInput = hin;
665 si.hStdOutput = hout;
666 si.hStdError = herr;
667
668 /* Create the environment block for the child. This is needed
669 because the environment we have in 'environ' is not in the format
670 expected by CreateProcess. */
671 prepare_envblk (environ, &env_block);
672
673 /* CreateProcess doesn't search PATH, so we must do that for it. */
674 progfile = lookup_cmd (exec_file, &bin_sh_replaced);
675
676 /* CreateProcess doesn't like forward slashes in the application
677 file name. */
678 for (p = progfile; *p; p++)
679 if (*p == '/')
680 *p = '\\';
681
682 /* Construct the command line. */
683 cmdline = prepare_cmdline (exec_file, (const char * const *)argv,
684 bin_sh_replaced);
685
686 /* All set and ready to fly. Launch the child process. */
687 if (!CreateProcess (progfile, cmdline, NULL, NULL, TRUE, 0, env_block, NULL,
688 &si, &pi))
689 {
690 pid = -1;
691
692 /* Since we use Win32 APIs directly, we need to translate their
693 errors to errno values by hand. */
694 switch (GetLastError ())
695 {
696 case ERROR_FILE_NOT_FOUND:
697 case ERROR_PATH_NOT_FOUND:
698 case ERROR_INVALID_DRIVE:
699 case ERROR_BAD_PATHNAME:
700 errno = ENOENT;
701 break;
702 case ERROR_ACCESS_DENIED:
703 errno = EACCES;
704 break;
705 case ERROR_BAD_ENVIRONMENT:
706 errno = E2BIG;
707 break;
708 case ERROR_BROKEN_PIPE:
709 errno = EPIPE;
710 break;
711 case ERROR_INVALID_HANDLE:
712 errno = EBADF;
713 break;
714 case ERROR_MAX_THRDS_REACHED:
715 errno = EAGAIN;
716 break;
717 case ERROR_BAD_EXE_FORMAT:
718 case ERROR_BAD_FORMAT:
719 default:
720 errno = ENOEXEC;
721 break;
722 }
723 }
724 else
725 {
726 scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);
727 record_proc (pi.dwProcessId, pi.hProcess);
728 scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
729 pid = pi.dwProcessId;
730 }
731
732 errno_save = errno;
733
734 /* Free resources. */
735 free (progfile);
736 free (cmdline);
737 free (env_block);
738 CloseHandle (hin);
739 CloseHandle (hout);
740 CloseHandle (herr);
741 CloseHandle (pi.hThread);
742
743 /* Posix requires to call the shell if execvp fails to invoke EXEC_FILE. */
744 if (errno_save == ENOEXEC || errno_save == ENOENT)
745 {
746 const char *shell = getenv ("ComSpec");
747
748 if (!shell)
749 shell = "cmd.exe";
750
751 if (c_strcasecmp (exec_file, shell) != 0)
752 {
753 argv[0] = (char *)exec_file;
754 return start_child (shell, argv, reading, c2p, writing, p2c,
755 infd, outfd, errfd);
756 }
757 }
758
759 errno = errno_save;
760 return pid;
761 }
762
763
764 /* Emulation of waitpid which only supports WNOHANG, since _cwait doesn't. */
765 int
waitpid(pid_t pid,int * status,int options)766 waitpid (pid_t pid, int *status, int options)
767 {
768 HANDLE ph;
769
770 /* Not supported on MS-Windows. */
771 if (pid <= 0)
772 {
773 errno = ENOSYS;
774 return -1;
775 }
776
777 scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);
778 ph = proc_handle (pid);
779 scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
780 /* Since scm_waitpid is documented to work only on child processes,
781 being unable to find a process in our records means failure. */
782 if (ph == INVALID_HANDLE_VALUE)
783 {
784 errno = ECHILD;
785 return -1;
786 }
787
788 if ((options & WNOHANG) != 0)
789 {
790 DWORD st;
791
792 if (!GetExitCodeProcess (ph, &st))
793 {
794 errno = ECHILD;
795 return -1;
796 }
797 if (st == STILL_ACTIVE)
798 return 0;
799 if (status)
800 *status = st;
801 CloseHandle (ph);
802 }
803 else
804 _cwait (status, (intptr_t)ph, WAIT_CHILD);
805
806 scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);
807 delete_proc (pid);
808 scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
809
810 return pid;
811 }
812
813
814 /* Translate abnormal exit status of Windows programs into the signal
815 that terminated the program. This is required to support scm_kill
816 and WTERMSIG. */
817
818 struct signal_and_status {
819 int sig;
820 DWORD status;
821 };
822
823 static const struct signal_and_status sigtbl[] = {
824 {SIGSEGV, 0xC0000005}, /* access to invalid address */
825 {SIGSEGV, 0xC0000008}, /* invalid handle */
826 {SIGILL, 0xC000001D}, /* illegal instruction */
827 {SIGILL, 0xC0000025}, /* non-continuable instruction */
828 {SIGSEGV, 0xC000008C}, /* array bounds exceeded */
829 {SIGFPE, 0xC000008D}, /* float denormal */
830 {SIGFPE, 0xC000008E}, /* float divide by zero */
831 {SIGFPE, 0xC000008F}, /* float inexact */
832 {SIGFPE, 0xC0000090}, /* float invalid operation */
833 {SIGFPE, 0xC0000091}, /* float overflow */
834 {SIGFPE, 0xC0000092}, /* float stack check */
835 {SIGFPE, 0xC0000093}, /* float underflow */
836 {SIGFPE, 0xC0000094}, /* integer divide by zero */
837 {SIGFPE, 0xC0000095}, /* integer overflow */
838 {SIGILL, 0xC0000096}, /* privileged instruction */
839 {SIGSEGV, 0xC00000FD}, /* stack overflow */
840 {SIGTERM, 0xC000013A}, /* Ctrl-C exit */
841 {SIGINT, 0xC000013A}
842 };
843
844 static int
w32_signal_to_status(int sig)845 w32_signal_to_status (int sig)
846 {
847 int i;
848
849 for (i = 0; i < sizeof (sigtbl) / sizeof (sigtbl[0]); i++)
850 if (sig == sigtbl[i].sig)
851 return sigtbl[i].status;
852
853 return (int)0xC000013A;
854 }
855
856 int
w32_status_to_termsig(DWORD status)857 w32_status_to_termsig (DWORD status)
858 {
859 int i;
860
861 for (i = 0; i < sizeof (sigtbl) / sizeof (sigtbl[0]); i++)
862 if (status == sigtbl[i].status)
863 return sigtbl[i].sig;
864
865 return SIGTERM;
866 }
867
868 /* Support for scm_kill. */
869 int
kill(int pid,int sig)870 kill (int pid, int sig)
871 {
872 HANDLE ph;
873 int child_proc = 0;
874
875 if (pid == getpid ())
876 {
877 if (raise (sig) == 0)
878 errno = ENOSYS;
879 return -1;
880 }
881
882 scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);
883 ph = proc_handle (pid);
884 scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
885 /* If not found among our subprocesses, look elsewhere in the
886 system. */
887 if (ph == INVALID_HANDLE_VALUE)
888 ph = OpenProcess (PROCESS_TERMINATE, 0, pid);
889 else
890 child_proc = 1;
891 if (!ph)
892 {
893 errno = EPERM;
894 return -1;
895 }
896 if (!TerminateProcess (ph, w32_signal_to_status (sig)))
897 {
898 /* If it's our subprocess, it could have already exited. In
899 that case, waitpid will handily delete the process from our
900 records, and we should return a more meaningful ESRCH to the
901 caller. */
902 if (child_proc && waitpid (pid, NULL, WNOHANG) == pid)
903 errno = ESRCH;
904 else
905 errno = EINVAL;
906 return -1;
907 }
908 CloseHandle (ph);
909 if (child_proc)
910 {
911 scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);
912 delete_proc (pid);
913 scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
914 }
915
916 return 0;
917 }
918
919 /* Emulation of getpriority and setpriority. */
920 #define NZERO 8
921
922 int
getpriority(int which,int who)923 getpriority (int which, int who)
924 {
925 HANDLE hp;
926 int nice_value = -1;
927 int error = 0;
928 int child_proc = 0;
929
930 /* We don't support process groups and users. */
931 if (which != PRIO_PROCESS)
932 {
933 errno = ENOSYS;
934 return -1;
935 }
936
937 if (who == 0)
938 hp = GetCurrentProcess ();
939 else
940 {
941 scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);
942 hp = proc_handle (who);
943 scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
944 /* If not found among our subprocesses, look elsewhere in the
945 system. */
946 if (hp == INVALID_HANDLE_VALUE)
947 hp = OpenProcess (PROCESS_QUERY_INFORMATION, FALSE, who);
948 else
949 child_proc = 1;
950 }
951
952 if (hp)
953 {
954 DWORD pri_class = GetPriorityClass (hp);
955
956 /* The pseudo-handle returned by GetCurrentProcess doesn't need
957 to be closed. */
958 if (who > 0 && !child_proc)
959 CloseHandle (hp);
960
961 if (pri_class > 0)
962 {
963 switch (pri_class)
964 {
965 case IDLE_PRIORITY_CLASS:
966 nice_value = 4;
967 break;
968 case BELOW_NORMAL_PRIORITY_CLASS:
969 nice_value = 6;
970 break;
971 case NORMAL_PRIORITY_CLASS:
972 nice_value = 8;
973 break;
974 case ABOVE_NORMAL_PRIORITY_CLASS:
975 nice_value = 10;
976 break;
977 case HIGH_PRIORITY_CLASS:
978 nice_value = 13;
979 break;
980 case REALTIME_PRIORITY_CLASS:
981 nice_value = 24;
982 break;
983 }
984 /* If WHO is us, we can provide a more fine-grained value by
985 looking at the current thread's priority value. (For
986 other processes, it is not clear which thread to use.) */
987 if (who == 0 || who == GetCurrentProcessId ())
988 {
989 HANDLE ht = GetCurrentThread ();
990 int tprio = GetThreadPriority (ht);
991
992 switch (tprio)
993 {
994 case THREAD_PRIORITY_IDLE:
995 if (pri_class == REALTIME_PRIORITY_CLASS)
996 nice_value = 16;
997 else
998 nice_value = 1;
999 break;
1000 case THREAD_PRIORITY_TIME_CRITICAL:
1001 if (pri_class == REALTIME_PRIORITY_CLASS)
1002 nice_value = 31;
1003 else
1004 nice_value = 15;
1005 case THREAD_PRIORITY_ERROR_RETURN:
1006 nice_value = -1;
1007 error = 1;
1008 break;
1009 default:
1010 nice_value += tprio;
1011 break;
1012 }
1013 }
1014 /* Map to "nice values" similar to what one would see on
1015 Posix platforms. */
1016 if (!error)
1017 nice_value = - (nice_value - NZERO);
1018 }
1019 else
1020 error = 1;
1021 }
1022 else
1023 error = 1;
1024
1025 if (error)
1026 {
1027 DWORD err = GetLastError ();
1028
1029 switch (err)
1030 {
1031 case ERROR_INVALID_PARAMETER:
1032 case ERROR_INVALID_THREAD_ID:
1033 errno = ESRCH;
1034 break;
1035 default:
1036 errno = EPERM;
1037 break;
1038 }
1039 }
1040
1041 return nice_value;
1042 }
1043
1044 int
setpriority(int which,int who,int nice_val)1045 setpriority (int which, int who, int nice_val)
1046 {
1047 HANDLE hp;
1048 DWORD err;
1049 int child_proc = 0, retval = -1;
1050
1051 if (which != PRIO_PROCESS)
1052 {
1053 errno = ENOSYS;
1054 return -1;
1055 }
1056
1057 if (who == 0)
1058 hp = GetCurrentProcess ();
1059 else
1060 {
1061 scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);
1062 hp = proc_handle (who);
1063 scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
1064 /* If not found among our subprocesses, look elsewhere in the
1065 system. */
1066 if (hp == INVALID_HANDLE_VALUE)
1067 hp = OpenProcess (PROCESS_SET_INFORMATION, FALSE, who);
1068 else
1069 child_proc = 1;
1070 }
1071
1072 if (hp)
1073 {
1074 DWORD pri_class;
1075
1076 /* Map "nice values" back to process priority classes. */
1077 nice_val = -nice_val + NZERO;
1078 if (nice_val < 6)
1079 pri_class = IDLE_PRIORITY_CLASS;
1080 else if (nice_val < 8)
1081 pri_class = BELOW_NORMAL_PRIORITY_CLASS;
1082 else if (nice_val < 10)
1083 pri_class = NORMAL_PRIORITY_CLASS;
1084 else if (nice_val < 13)
1085 pri_class = ABOVE_NORMAL_PRIORITY_CLASS;
1086 else if (nice_val < 16)
1087 pri_class = HIGH_PRIORITY_CLASS;
1088 else
1089 pri_class = REALTIME_PRIORITY_CLASS;
1090
1091 if (SetPriorityClass (hp, pri_class))
1092 retval = 0;
1093 }
1094
1095 err = GetLastError ();
1096
1097 switch (err)
1098 {
1099 case ERROR_INVALID_PARAMETER:
1100 errno = ESRCH;
1101 break;
1102 default:
1103 errno = EPERM;
1104 break;
1105 }
1106 /* The pseudo-handle returned by GetCurrentProcess doesn't
1107 need to be closed. */
1108 if (hp && who > 0 && !child_proc)
1109 CloseHandle (hp);
1110
1111 return retval;
1112 }
1113
1114 /* Emulation of sched_getaffinity and sched_setaffinity. */
1115 int
sched_getaffinity(int pid,size_t mask_size,cpu_set_t * mask)1116 sched_getaffinity (int pid, size_t mask_size, cpu_set_t *mask)
1117 {
1118 HANDLE hp;
1119 DWORD err;
1120 int child_proc = 0;
1121
1122 if (mask == NULL)
1123 {
1124 errno = EFAULT;
1125 return -1;
1126 }
1127
1128 if (pid == 0)
1129 hp = GetCurrentProcess ();
1130 else
1131 {
1132 scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);
1133 hp = proc_handle (pid);
1134 scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
1135 /* If not found among our subprocesses, look elsewhere in the
1136 system. */
1137 if (hp == INVALID_HANDLE_VALUE)
1138 hp = OpenProcess (PROCESS_QUERY_INFORMATION, FALSE, pid);
1139 else
1140 child_proc = 1;
1141 }
1142
1143 if (hp)
1144 {
1145 DWORD_PTR ignored;
1146 BOOL result = GetProcessAffinityMask (hp, (DWORD_PTR *)mask, &ignored);
1147
1148 /* The pseudo-handle returned by GetCurrentProcess doesn't
1149 need to be closed. */
1150 if (pid > 0 && !child_proc)
1151 CloseHandle (hp);
1152 if (result)
1153 return 0;
1154 }
1155
1156 err = GetLastError ();
1157
1158 switch (err)
1159 {
1160 case ERROR_INVALID_PARAMETER:
1161 errno = ESRCH;
1162 break;
1163 case ERROR_ACCESS_DENIED:
1164 default:
1165 errno = EPERM;
1166 break;
1167 }
1168
1169 return -1;
1170 }
1171
1172 int
sched_setaffinity(int pid,size_t mask_size,cpu_set_t * mask)1173 sched_setaffinity (int pid, size_t mask_size, cpu_set_t *mask)
1174 {
1175 HANDLE hp;
1176 DWORD err;
1177 int child_proc = 0;
1178
1179 if (mask == NULL)
1180 {
1181 errno = EFAULT;
1182 return -1;
1183 }
1184
1185 if (pid == 0)
1186 hp = GetCurrentProcess ();
1187 else
1188 {
1189 scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);
1190 hp = proc_handle (pid);
1191 scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
1192 /* If not found among our subprocesses, look elsewhere in the
1193 system. */
1194 if (hp == INVALID_HANDLE_VALUE)
1195 hp = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
1196 else
1197 child_proc = 1;
1198 }
1199
1200 if (hp)
1201 {
1202 BOOL result = SetProcessAffinityMask (hp, *(DWORD_PTR *)mask);
1203
1204 /* The pseudo-handle returned by GetCurrentProcess doesn't
1205 need to be closed. */
1206 if (pid > 0 && !child_proc)
1207 CloseHandle (hp);
1208 if (result)
1209 return 0;
1210 }
1211
1212 err = GetLastError ();
1213
1214 switch (err)
1215 {
1216 case ERROR_INVALID_PARAMETER:
1217 errno = ESRCH;
1218 break;
1219 case ERROR_ACCESS_DENIED:
1220 default:
1221 errno = EPERM;
1222 break;
1223 }
1224
1225 return -1;
1226 }
1227