1 /* Interfaces to system-dependent kernel and library entries.
2 Copyright (C) 1985-1988, 1993-1995, 1999-2021 Free Software
3 Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or (at
10 your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
19
20 #include <config.h>
21
22 #include <execinfo.h>
23 #include "sysstdio.h"
24 #ifdef HAVE_PWD_H
25 #include <pwd.h>
26 #include <grp.h>
27 #endif /* HAVE_PWD_H */
28 #include <limits.h>
29 #include <stdlib.h>
30 #include <sys/random.h>
31 #include <unistd.h>
32
33 #include <c-ctype.h>
34 #include <close-stream.h>
35 #include <pathmax.h>
36 #include <utimens.h>
37
38 #include "lisp.h"
39 #include "sheap.h"
40 #include "sysselect.h"
41 #include "blockinput.h"
42
43 #ifdef HAVE_LINUX_FS_H
44 # include <linux/fs.h>
45 # include <sys/syscall.h>
46 #endif
47
48 #ifdef CYGWIN
49 # include <cygwin/fs.h>
50 #endif
51
52 #if defined DARWIN_OS || defined __FreeBSD__ || defined __OpenBSD__
53 # include <sys/sysctl.h>
54 #endif
55
56 #if defined __OpenBSD__
57 # include <sys/proc.h>
58 #endif
59
60 #ifdef DARWIN_OS
61 # include <libproc.h>
62 #endif
63
64 #ifdef __FreeBSD__
65 /* Sparc/ARM machine/frame.h has 'struct frame' which conflicts with Emacs's
66 'struct frame', so rename it. */
67 # define frame freebsd_frame
68 # include <sys/user.h>
69 # undef frame
70
71 # include <math.h>
72 #endif
73
74 #ifdef HAVE_SOCKETS
75 #include <sys/socket.h>
76 #include <netdb.h>
77 #endif /* HAVE_SOCKETS */
78
79 #ifdef WINDOWSNT
80 #define read sys_read
81 #define write sys_write
82 #ifndef STDERR_FILENO
83 #define STDERR_FILENO fileno(GetStdHandle(STD_ERROR_HANDLE))
84 #endif
85 #include "w32.h"
86 #endif /* WINDOWSNT */
87
88 #include <sys/types.h>
89 #include <sys/stat.h>
90 #include <errno.h>
91
92 /* Get SI_SRPC_DOMAIN, if it is available. */
93 #ifdef HAVE_SYS_SYSTEMINFO_H
94 #include <sys/systeminfo.h>
95 #endif
96
97 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida, MW Aug 1993 */
98 #include "msdos.h"
99 #endif
100
101 #include <sys/param.h>
102 #include <sys/file.h>
103 #include <fcntl.h>
104
105 #include "syssignal.h"
106 #include "systime.h"
107 #include "systty.h"
108 #include "syswait.h"
109
110 #ifdef HAVE_SYS_RESOURCE_H
111 # include <sys/resource.h>
112 #endif
113
114 #ifdef HAVE_SYS_UTSNAME_H
115 # include <sys/utsname.h>
116 # include <memory.h>
117 #endif
118
119 #include "keyboard.h"
120 #include "frame.h"
121 #include "termhooks.h"
122 #include "termchar.h"
123 #include "termopts.h"
124 #include "process.h"
125 #include "cm.h"
126
127 #ifdef WINDOWSNT
128 # include <direct.h>
129 /* In process.h which conflicts with the local copy. */
130 # define _P_WAIT 0
131 int _cdecl _spawnlp (int, const char *, const char *, ...);
132 /* The following is needed for O_CLOEXEC, F_SETFD, FD_CLOEXEC, and
133 several prototypes of functions called below. */
134 # include <sys/socket.h>
135 #endif
136
137 /* Declare here, including term.h is problematic on some systems. */
138 extern void tputs (const char *, int, int (*)(int));
139
140 static const int baud_convert[] =
141 {
142 0, 50, 75, 110, 135, 150, 200, 300, 600, 1200,
143 1800, 2400, 4800, 9600, 19200, 38400
144 };
145
146 #ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE
147 # include <sys/personality.h>
148
149 /* If not -1, the personality that should be restored before exec. */
150 static int exec_personality;
151
152 /* Try to disable randomization if the current process needs it and
153 does not appear to have it already. */
154 int
maybe_disable_address_randomization(int argc,char ** argv)155 maybe_disable_address_randomization (int argc, char **argv)
156 {
157 /* Undocumented Emacs option used only by this function. */
158 static char const aslr_disabled_option[] = "--__aslr-disabled";
159
160 if (argc < 2 || strcmp (argv[1], aslr_disabled_option) != 0)
161 {
162 /* If dumping via unexec, ASLR must be disabled, as otherwise
163 data may be scattered and undumpable as a simple executable.
164 If pdumping, disabling ASLR lessens differences in the .pdmp file. */
165 bool disable_aslr = will_dump_p ();
166 # ifdef __PPC64__
167 disable_aslr = true;
168 # endif
169 exec_personality = disable_aslr ? personality (0xffffffff) : -1;
170 if (exec_personality & ADDR_NO_RANDOMIZE)
171 exec_personality = -1;
172 if (exec_personality != -1
173 && personality (exec_personality | ADDR_NO_RANDOMIZE) != -1)
174 {
175 char **newargv = malloc ((argc + 2) * sizeof *newargv);
176 if (newargv)
177 {
178 /* Invoke self with undocumented option. */
179 newargv[0] = argv[0];
180 newargv[1] = (char *) aslr_disabled_option;
181 memcpy (&newargv[2], &argv[1], argc * sizeof *newargv);
182 execvp (newargv[0], newargv);
183 }
184
185 /* If malloc or execvp fails, warn and then try anyway. */
186 perror (argv[0]);
187 free (newargv);
188 }
189 }
190 else
191 {
192 /* Our earlier incarnation already disabled ASLR. */
193 argc--;
194 memmove (&argv[1], &argv[2], argc * sizeof *argv);
195 }
196
197 return argc;
198 }
199 #endif
200
201 #ifndef WINDOWSNT
202 /* Execute the program in FILE, with argument vector ARGV and environ
203 ENVP. Return an error number if unsuccessful. This is like execve
204 except it reenables ASLR in the executed program if necessary, and
205 on error it returns an error number rather than -1. */
206 int
emacs_exec_file(char const * file,char * const * argv,char * const * envp)207 emacs_exec_file (char const *file, char *const *argv, char *const *envp)
208 {
209 #ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE
210 if (exec_personality != -1)
211 personality (exec_personality);
212 #endif
213
214 execve (file, argv, envp);
215 return errno;
216 }
217
218 #endif /* !WINDOWSNT */
219
220 /* If FD is not already open, arrange for it to be open with FLAGS. */
221 static void
force_open(int fd,int flags)222 force_open (int fd, int flags)
223 {
224 if (dup2 (fd, fd) < 0 && errno == EBADF)
225 {
226 int n = open (NULL_DEVICE, flags);
227 if (n < 0 || (fd != n && (dup2 (n, fd) < 0 || emacs_close (n) != 0)))
228 {
229 emacs_perror (NULL_DEVICE);
230 exit (EXIT_FAILURE);
231 }
232 }
233 }
234
235 /* A stream that is like stderr, except line buffered. It is NULL
236 during startup, or if line buffering is not in use. */
237 static FILE *buferr;
238
239 /* Make sure stdin, stdout, and stderr are open to something, so that
240 their file descriptors are not hijacked by later system calls. */
241 void
init_standard_fds(void)242 init_standard_fds (void)
243 {
244 /* Open stdin for *writing*, and stdout and stderr for *reading*.
245 That way, any attempt to do normal I/O will result in an error,
246 just as if the files were closed, and the file descriptors will
247 not be reused by later opens. */
248 force_open (STDIN_FILENO, O_WRONLY);
249 force_open (STDOUT_FILENO, O_RDONLY);
250 force_open (STDERR_FILENO, O_RDONLY);
251
252 /* Set buferr if possible on platforms defining _PC_PIPE_BUF, as
253 they support the notion of atomic writes to pipes. */
254 #ifdef _PC_PIPE_BUF
255 buferr = fdopen (STDERR_FILENO, "w");
256 if (buferr)
257 setvbuf (buferr, NULL, _IOLBF, 0);
258 #endif
259 }
260
261 /* Return the current working directory. The result should be freed
262 with 'free'. Return NULL (setting errno) on errors. If the
263 current directory is unreachable, return either NULL or a string
264 beginning with '('. */
265
266 static char *
get_current_dir_name_or_unreachable(void)267 get_current_dir_name_or_unreachable (void)
268 {
269 /* Use malloc, not xmalloc, since this function can be called before
270 the xmalloc exception machinery is available. */
271
272 char *pwd;
273
274 /* The maximum size of a directory name, including the terminating null.
275 Leave room so that the caller can append a trailing slash. */
276 ptrdiff_t dirsize_max = min (PTRDIFF_MAX, SIZE_MAX) - 1;
277
278 /* The maximum size of a buffer for a file name, including the
279 terminating null. This is bounded by PATH_MAX, if available. */
280 ptrdiff_t bufsize_max = dirsize_max;
281 #ifdef PATH_MAX
282 bufsize_max = min (bufsize_max, PATH_MAX);
283 #endif
284
285 # if HAVE_GET_CURRENT_DIR_NAME && !BROKEN_GET_CURRENT_DIR_NAME
286 # ifdef HYBRID_MALLOC
287 bool use_libc = will_dump_with_unexec_p ();
288 # else
289 bool use_libc = true;
290 # endif
291 if (use_libc)
292 {
293 /* For an unreachable directory, this returns a string that starts
294 with "(unreachable)"; see Bug#27871. */
295 pwd = get_current_dir_name ();
296 if (pwd)
297 {
298 if (strnlen (pwd, dirsize_max) < dirsize_max)
299 return pwd;
300 free (pwd);
301 errno = ERANGE;
302 }
303 return NULL;
304 }
305 # endif
306
307 size_t pwdlen;
308 struct stat dotstat, pwdstat;
309 pwd = getenv ("PWD");
310
311 /* If PWD is accurate, use it instead of calling getcwd. PWD is
312 sometimes a nicer name, and using it may avoid a fatal error if a
313 parent directory is searchable but not readable. */
314 if (pwd
315 && (pwdlen = strnlen (pwd, bufsize_max)) < bufsize_max
316 && IS_DIRECTORY_SEP (pwd[pwdlen && IS_DEVICE_SEP (pwd[1]) ? 2 : 0])
317 && emacs_fstatat (AT_FDCWD, pwd, &pwdstat, 0) == 0
318 && emacs_fstatat (AT_FDCWD, ".", &dotstat, 0) == 0
319 && dotstat.st_ino == pwdstat.st_ino
320 && dotstat.st_dev == pwdstat.st_dev)
321 return strdup (pwd);
322 else
323 {
324 ptrdiff_t buf_size = min (bufsize_max, 1024);
325 for (;;)
326 {
327 char *buf = malloc (buf_size);
328 if (!buf)
329 return NULL;
330 if (getcwd (buf, buf_size) == buf)
331 return buf;
332 free (buf);
333 if (errno != ERANGE || buf_size == bufsize_max)
334 return NULL;
335 buf_size = buf_size <= bufsize_max / 2 ? 2 * buf_size : bufsize_max;
336 }
337 }
338 }
339
340 /* Return the current working directory. The result should be freed
341 with 'free'. Return NULL (setting errno) on errors; an unreachable
342 directory (e.g., its name starts with '(') counts as an error. */
343
344 char *
emacs_get_current_dir_name(void)345 emacs_get_current_dir_name (void)
346 {
347 char *dir = get_current_dir_name_or_unreachable ();
348 if (dir && *dir == '(')
349 {
350 free (dir);
351 errno = ENOENT;
352 return NULL;
353 }
354 return dir;
355 }
356
357
358 /* Discard pending input on all input descriptors. */
359
360 void
discard_tty_input(void)361 discard_tty_input (void)
362 {
363 #ifndef WINDOWSNT
364 struct emacs_tty buf;
365
366 if (noninteractive)
367 return;
368
369 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
370 while (dos_keyread () != -1)
371 ;
372 #else /* not MSDOS */
373 {
374 struct tty_display_info *tty;
375 for (tty = tty_list; tty; tty = tty->next)
376 {
377 if (tty->input) /* Is the device suspended? */
378 {
379 emacs_get_tty (fileno (tty->input), &buf);
380 emacs_set_tty (fileno (tty->input), &buf, 0);
381 }
382 }
383 }
384 #endif /* not MSDOS */
385 #endif /* not WINDOWSNT */
386 }
387
388
389 #ifdef SIGTSTP
390
391 /* Arrange for character C to be read as the next input from
392 the terminal.
393 XXX What if we have multiple ttys?
394 */
395
396 void
stuff_char(char c)397 stuff_char (char c)
398 {
399 if (! (FRAMEP (selected_frame)
400 && FRAME_LIVE_P (XFRAME (selected_frame))
401 && FRAME_TERMCAP_P (XFRAME (selected_frame))))
402 return;
403
404 /* Should perhaps error if in batch mode */
405 #ifdef TIOCSTI
406 ioctl (fileno (CURTTY()->input), TIOCSTI, &c);
407 #else /* no TIOCSTI */
408 error ("Cannot stuff terminal input characters in this version of Unix");
409 #endif /* no TIOCSTI */
410 }
411
412 #endif /* SIGTSTP */
413
414 void
init_baud_rate(int fd)415 init_baud_rate (int fd)
416 {
417 int emacs_ospeed;
418
419 if (noninteractive)
420 emacs_ospeed = 0;
421 else
422 {
423 #ifdef DOS_NT
424 emacs_ospeed = 15;
425 #else /* not DOS_NT */
426 struct termios sg;
427
428 sg.c_cflag = B9600;
429 tcgetattr (fd, &sg);
430 emacs_ospeed = cfgetospeed (&sg);
431 #endif /* not DOS_NT */
432 }
433
434 baud_rate = (emacs_ospeed < ARRAYELTS (baud_convert)
435 ? baud_convert[emacs_ospeed] : 9600);
436 if (baud_rate == 0)
437 baud_rate = 1200;
438 }
439
440
441
442 #ifndef MSDOS
443
444 /* Wait for the subprocess with process id CHILD to terminate or change status.
445 CHILD must be a child process that has not been reaped.
446 If STATUS is non-null, store the waitpid-style exit status into *STATUS
447 and tell wait_reading_process_output that it needs to look around.
448 Use waitpid-style OPTIONS when waiting.
449 If INTERRUPTIBLE, this function is interruptible by a signal.
450
451 Return CHILD if successful, 0 if no status is available, and a
452 negative value (setting errno) if waitpid is buggy. */
453 static pid_t
get_child_status(pid_t child,int * status,int options,bool interruptible)454 get_child_status (pid_t child, int *status, int options, bool interruptible)
455 {
456 pid_t pid;
457
458 /* Invoke waitpid only with a known process ID; do not invoke
459 waitpid with a nonpositive argument. Otherwise, Emacs might
460 reap an unwanted process by mistake. For example, invoking
461 waitpid (-1, ...) can mess up glib by reaping glib's subprocesses,
462 so that another thread running glib won't find them. */
463 eassert (child > 0);
464
465 while (true)
466 {
467 /* Note: the MS-Windows emulation of waitpid calls maybe_quit
468 internally. */
469 if (interruptible)
470 maybe_quit ();
471
472 pid = waitpid (child, status, options);
473 if (0 <= pid)
474 break;
475 if (errno != EINTR)
476 {
477 /* Most likely, waitpid is buggy and the operating system
478 lost track of the child somehow. Return -1 and let the
479 caller try to figure things out. Possibly the bug could
480 cause Emacs to kill the wrong process. Oh well. */
481 return pid;
482 }
483 }
484
485 /* If successful and status is requested, tell wait_reading_process_output
486 that it needs to wake up and look around. */
487 if (pid && status && input_available_clear_time)
488 *input_available_clear_time = make_timespec (0, 0);
489
490 return pid;
491 }
492
493 /* Wait for the subprocess with process id CHILD to terminate.
494 CHILD must be a child process that has not been reaped.
495 If STATUS is non-null, store the waitpid-style exit status into *STATUS
496 and tell wait_reading_process_output that it needs to look around.
497 If INTERRUPTIBLE, this function is interruptible by a signal.
498 Return true if successful, false (setting errno) if CHILD cannot be
499 waited for because waitpid is buggy. */
500 bool
wait_for_termination(pid_t child,int * status,bool interruptible)501 wait_for_termination (pid_t child, int *status, bool interruptible)
502 {
503 return 0 <= get_child_status (child, status, 0, interruptible);
504 }
505
506 /* Report whether the subprocess with process id CHILD has changed status.
507 Termination counts as a change of status.
508 CHILD must be a child process that has not been reaped.
509 If STATUS is non-null, store the waitpid-style exit status into *STATUS
510 and tell wait_reading_process_output that it needs to look around.
511 Use waitpid-style OPTIONS to check status, but do not wait.
512
513 Return CHILD if successful, 0 if no status is available because
514 the process's state has not changed. */
515 pid_t
child_status_changed(pid_t child,int * status,int options)516 child_status_changed (pid_t child, int *status, int options)
517 {
518 return get_child_status (child, status, WNOHANG | options, 0);
519 }
520
521
522 /* Set up the terminal at the other end of a pseudo-terminal that
523 we will be controlling an inferior through.
524 It should not echo or do line-editing, since that is done
525 in Emacs. No padding needed for insertion into an Emacs buffer. */
526
527 void
child_setup_tty(int out)528 child_setup_tty (int out)
529 {
530 #ifndef WINDOWSNT
531 struct emacs_tty s;
532
533 emacs_get_tty (out, &s);
534 s.main.c_oflag |= OPOST; /* Enable output postprocessing */
535 s.main.c_oflag &= ~ONLCR; /* Disable map of NL to CR-NL on output */
536 #ifdef NLDLY
537 /* https://lists.gnu.org/r/emacs-devel/2008-05/msg00406.html
538 Some versions of GNU Hurd do not have FFDLY? */
539 #ifdef FFDLY
540 s.main.c_oflag &= ~(NLDLY|CRDLY|TABDLY|BSDLY|VTDLY|FFDLY);
541 /* No output delays */
542 #else
543 s.main.c_oflag &= ~(NLDLY|CRDLY|TABDLY|BSDLY|VTDLY);
544 /* No output delays */
545 #endif
546 #endif
547 s.main.c_lflag &= ~ECHO; /* Disable echo */
548 s.main.c_lflag |= ISIG; /* Enable signals */
549 #ifdef IUCLC
550 s.main.c_iflag &= ~IUCLC; /* Disable downcasing on input. */
551 #endif
552 #ifdef ISTRIP
553 s.main.c_iflag &= ~ISTRIP; /* don't strip 8th bit on input */
554 #endif
555 #ifdef OLCUC
556 s.main.c_oflag &= ~OLCUC; /* Disable upcasing on output. */
557 #endif
558 s.main.c_oflag &= ~TAB3; /* Disable tab expansion */
559 s.main.c_cflag = (s.main.c_cflag & ~CSIZE) | CS8; /* Don't strip 8th bit */
560 s.main.c_cc[VERASE] = CDISABLE; /* disable erase processing */
561 s.main.c_cc[VKILL] = CDISABLE; /* disable kill processing */
562
563 #ifdef HPUX
564 s.main.c_cflag = (s.main.c_cflag & ~CBAUD) | B9600; /* baud rate sanity */
565 #endif /* HPUX */
566
567 #ifdef SIGNALS_VIA_CHARACTERS
568 /* the QUIT and INTR character are used in process_send_signal
569 so set them here to something useful. */
570 if (s.main.c_cc[VQUIT] == CDISABLE)
571 s.main.c_cc[VQUIT] = '\\'&037; /* Control-\ */
572 if (s.main.c_cc[VINTR] == CDISABLE)
573 s.main.c_cc[VINTR] = 'C'&037; /* Control-C */
574 #endif /* not SIGNALS_VIA_CHARACTERS */
575
576 #ifdef AIX
577 /* Also, PTY overloads NUL and BREAK.
578 don't ignore break, but don't signal either, so it looks like NUL. */
579 s.main.c_iflag &= ~IGNBRK;
580 s.main.c_iflag &= ~BRKINT;
581 /* rms: Formerly it set s.main.c_cc[VINTR] to 0377 here
582 unconditionally. Then a SIGNALS_VIA_CHARACTERS conditional
583 would force it to 0377. That looks like duplicated code. */
584 s.main.c_cflag = (s.main.c_cflag & ~CBAUD) | B9600; /* baud rate sanity */
585 #endif /* AIX */
586
587 /* We originally enabled ICANON (and set VEOF to 04), and then had
588 process.c send additional EOF chars to flush the output when faced
589 with long lines, but this leads to weird effects when the
590 subprocess has disabled ICANON and ends up seeing those spurious
591 extra EOFs. So we don't send EOFs any more in
592 process.c:send_process. First we tried to disable ICANON by
593 default, so if a subsprocess sets up ICANON, it's his problem (or
594 the Elisp package that talks to it) to deal with lines that are
595 too long. But this disables some features, such as the ability
596 to send EOF signals. So we re-enabled ICANON but there is no
597 more "send eof to flush" going on (which is wrong and unportable
598 in itself). The correct way to handle too much output is to
599 buffer what could not be written and then write it again when
600 select returns ok for writing. This has it own set of
601 problems. Write is now asynchronous, is that a problem? How much
602 do we buffer, and what do we do when that limit is reached? */
603
604 s.main.c_lflag |= ICANON; /* Enable line editing and eof processing */
605 s.main.c_cc[VEOF] = 'D'&037; /* Control-D */
606 #if 0 /* These settings only apply to non-ICANON mode. */
607 s.main.c_cc[VMIN] = 1;
608 s.main.c_cc[VTIME] = 0;
609 #endif
610
611 emacs_set_tty (out, &s, 0);
612 #endif /* not WINDOWSNT */
613 }
614 #endif /* not MSDOS */
615
616
617 /* Record a signal code and the action for it. */
618 struct save_signal
619 {
620 int code;
621 struct sigaction action;
622 };
623
624 static void save_signal_handlers (struct save_signal *);
625 static void restore_signal_handlers (struct save_signal *);
626
627 /* Suspend the Emacs process; give terminal to its superior. */
628
629 void
sys_suspend(void)630 sys_suspend (void)
631 {
632 #ifndef DOS_NT
633 kill (0, SIGTSTP);
634 #else
635 /* On a system where suspending is not implemented,
636 instead fork a subshell and let it talk directly to the terminal
637 while we wait. */
638 sys_subshell ();
639
640 #endif
641 }
642
643 /* Fork a subshell. */
644
645 void
sys_subshell(void)646 sys_subshell (void)
647 {
648 #ifdef DOS_NT /* Demacs 1.1.2 91/10/20 Manabu Higashida */
649 #ifdef MSDOS
650 int st;
651 char oldwd[MAXPATHLEN+1]; /* Fixed length is safe on MSDOS. */
652 #else
653 char oldwd[MAX_UTF8_PATH];
654 #endif /* MSDOS */
655 #else /* !DOS_NT */
656 int status;
657 #endif
658 pid_t pid;
659 struct save_signal saved_handlers[5];
660 char *str = SSDATA (get_current_directory (true));
661
662 #ifdef DOS_NT
663 pid = 0;
664 #else
665 {
666 char *volatile str_volatile = str;
667 pid = vfork ();
668 str = str_volatile;
669 }
670 #endif
671
672 if (pid < 0)
673 error ("Can't spawn subshell");
674
675 saved_handlers[0].code = SIGINT;
676 saved_handlers[1].code = SIGQUIT;
677 saved_handlers[2].code = SIGTERM;
678 #ifdef USABLE_SIGIO
679 saved_handlers[3].code = SIGIO;
680 saved_handlers[4].code = 0;
681 #elif defined (USABLE_SIGPOLL)
682 saved_handlers[3].code = SIGPOLL;
683 saved_handlers[4].code = 0;
684 #else
685 saved_handlers[3].code = 0;
686 #endif
687
688 #ifdef DOS_NT
689 save_signal_handlers (saved_handlers);
690 #endif
691
692 if (pid == 0)
693 {
694 const char *sh = 0;
695
696 #ifdef DOS_NT /* MW, Aug 1993 */
697 getcwd (oldwd, sizeof oldwd);
698 if (sh == 0)
699 sh = egetenv ("SUSPEND"); /* KFS, 1994-12-14 */
700 #endif
701 if (sh == 0)
702 sh = egetenv ("SHELL");
703 if (sh == 0)
704 sh = "sh";
705
706 /* Use our buffer's default directory for the subshell. */
707 if (chdir (str) != 0)
708 {
709 #ifndef DOS_NT
710 emacs_perror (str);
711 _exit (EXIT_CANCELED);
712 #endif
713 }
714
715 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */
716 {
717 char *epwd = getenv ("PWD");
718 char old_pwd[MAXPATHLEN+1+4];
719
720 /* If PWD is set, pass it with corrected value. */
721 if (epwd)
722 {
723 strcpy (old_pwd, epwd);
724 setenv ("PWD", str, 1);
725 }
726 st = system (sh);
727 chdir (oldwd); /* FIXME: Do the right thing on chdir failure. */
728 if (epwd)
729 putenv (old_pwd); /* restore previous value */
730 }
731 #else /* not MSDOS */
732 #ifdef WINDOWSNT
733 /* Waits for process completion */
734 pid = _spawnlp (_P_WAIT, sh, sh, NULL);
735 chdir (oldwd); /* FIXME: Do the right thing on chdir failure. */
736 if (pid == -1)
737 write (1, "Can't execute subshell", 22);
738 #else /* not WINDOWSNT */
739 execlp (sh, sh, (char *) 0);
740 emacs_perror (sh);
741 _exit (errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
742 #endif /* not WINDOWSNT */
743 #endif /* not MSDOS */
744 }
745
746 /* Do this now if we did not do it before. */
747 #ifndef MSDOS
748 save_signal_handlers (saved_handlers);
749 #endif
750
751 #ifndef DOS_NT
752 wait_for_termination (pid, &status, 0);
753 #endif
754 restore_signal_handlers (saved_handlers);
755 }
756
757 static void
save_signal_handlers(struct save_signal * saved_handlers)758 save_signal_handlers (struct save_signal *saved_handlers)
759 {
760 while (saved_handlers->code)
761 {
762 struct sigaction action;
763 emacs_sigaction_init (&action, SIG_IGN);
764 sigaction (saved_handlers->code, &action, &saved_handlers->action);
765 saved_handlers++;
766 }
767 }
768
769 static void
restore_signal_handlers(struct save_signal * saved_handlers)770 restore_signal_handlers (struct save_signal *saved_handlers)
771 {
772 while (saved_handlers->code)
773 {
774 sigaction (saved_handlers->code, &saved_handlers->action, 0);
775 saved_handlers++;
776 }
777 }
778
779 #ifdef USABLE_SIGIO
780 static int old_fcntl_flags[FD_SETSIZE];
781 #endif
782
783 void
init_sigio(int fd)784 init_sigio (int fd)
785 {
786 #ifdef USABLE_SIGIO
787 old_fcntl_flags[fd] = fcntl (fd, F_GETFL, 0) & ~FASYNC;
788 fcntl (fd, F_SETFL, old_fcntl_flags[fd] | FASYNC);
789 interrupts_deferred = 0;
790 #endif
791 }
792
793 #ifndef DOS_NT
794 #ifdef F_SETOWN
795 static void
reset_sigio(int fd)796 reset_sigio (int fd)
797 {
798 #ifdef USABLE_SIGIO
799 fcntl (fd, F_SETFL, old_fcntl_flags[fd]);
800 #endif
801 }
802 #endif /* F_SETOWN */
803 #endif
804
805 void
request_sigio(void)806 request_sigio (void)
807 {
808 #if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
809 sigset_t unblocked;
810
811 if (noninteractive)
812 return;
813
814 sigemptyset (&unblocked);
815 # ifdef SIGWINCH
816 sigaddset (&unblocked, SIGWINCH);
817 # endif
818 # ifdef USABLE_SIGIO
819 sigaddset (&unblocked, SIGIO);
820 # else
821 sigaddset (&unblocked, SIGPOLL);
822 # endif
823 pthread_sigmask (SIG_UNBLOCK, &unblocked, 0);
824
825 interrupts_deferred = 0;
826 #endif
827 }
828
829 void
unrequest_sigio(void)830 unrequest_sigio (void)
831 {
832 #if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
833 sigset_t blocked;
834
835 if (noninteractive)
836 return;
837
838 sigemptyset (&blocked);
839 # ifdef SIGWINCH
840 sigaddset (&blocked, SIGWINCH);
841 # endif
842 # ifdef USABLE_SIGIO
843 sigaddset (&blocked, SIGIO);
844 # else
845 sigaddset (&blocked, SIGPOLL);
846 # endif
847 pthread_sigmask (SIG_BLOCK, &blocked, 0);
848 interrupts_deferred = 1;
849 #endif
850 }
851
852 #ifndef MSDOS
853 /* Block SIGCHLD. */
854
855 void
block_child_signal(sigset_t * oldset)856 block_child_signal (sigset_t *oldset)
857 {
858 sigset_t blocked;
859 sigemptyset (&blocked);
860 sigaddset (&blocked, SIGCHLD);
861 sigaddset (&blocked, SIGINT);
862 pthread_sigmask (SIG_BLOCK, &blocked, oldset);
863 }
864
865 /* Unblock SIGCHLD. */
866
867 void
unblock_child_signal(sigset_t const * oldset)868 unblock_child_signal (sigset_t const *oldset)
869 {
870 pthread_sigmask (SIG_SETMASK, oldset, 0);
871 }
872
873 #endif /* !MSDOS */
874
875 /* Block SIGINT. */
876 void
block_interrupt_signal(sigset_t * oldset)877 block_interrupt_signal (sigset_t *oldset)
878 {
879 sigset_t blocked;
880 sigemptyset (&blocked);
881 sigaddset (&blocked, SIGINT);
882 pthread_sigmask (SIG_BLOCK, &blocked, oldset);
883 }
884
885 /* Restore previously saved signal mask. */
886 void
restore_signal_mask(sigset_t const * oldset)887 restore_signal_mask (sigset_t const *oldset)
888 {
889 pthread_sigmask (SIG_SETMASK, oldset, 0);
890 }
891
892
893 /* Saving and restoring the process group of Emacs's terminal. */
894
895 /* The process group of which Emacs was a member when it initially
896 started.
897
898 If Emacs was in its own process group (i.e. inherited_pgroup ==
899 getpid ()), then we know we're running under a shell with job
900 control (Emacs would never be run as part of a pipeline).
901 Everything is fine.
902
903 If Emacs was not in its own process group, then we know we're
904 running under a shell (or a caller) that doesn't know how to
905 separate itself from Emacs (like sh). Emacs must be in its own
906 process group in order to receive SIGIO correctly. In this
907 situation, we put ourselves in our own pgroup, forcibly set the
908 tty's pgroup to our pgroup, and make sure to restore and reinstate
909 the tty's pgroup just like any other terminal setting. If
910 inherited_group was not the tty's pgroup, then we'll get a
911 SIGTTmumble when we try to change the tty's pgroup, and a CONT if
912 it goes foreground in the future, which is what should happen. */
913
914 static pid_t inherited_pgroup;
915
916 void
init_foreground_group(void)917 init_foreground_group (void)
918 {
919 pid_t pgrp = getpgrp ();
920 inherited_pgroup = getpid () == pgrp ? 0 : pgrp;
921 }
922
923 /* Block and unblock SIGTTOU. */
924
925 void
block_tty_out_signal(sigset_t * oldset)926 block_tty_out_signal (sigset_t *oldset)
927 {
928 #ifdef SIGTTOU
929 sigset_t blocked;
930 sigemptyset (&blocked);
931 sigaddset (&blocked, SIGTTOU);
932 pthread_sigmask (SIG_BLOCK, &blocked, oldset);
933 #endif
934 }
935
936 void
unblock_tty_out_signal(sigset_t const * oldset)937 unblock_tty_out_signal (sigset_t const *oldset)
938 {
939 #ifdef SIGTTOU
940 pthread_sigmask (SIG_SETMASK, oldset, 0);
941 #endif
942 }
943
944 /* Safely set a controlling terminal FD's process group to PGID.
945 If we are not in the foreground already, POSIX requires tcsetpgrp
946 to deliver a SIGTTOU signal, which would stop us. This is an
947 annoyance, so temporarily ignore the signal.
948
949 In practice, platforms lacking SIGTTOU also lack tcsetpgrp, so
950 skip all this unless SIGTTOU is defined. */
951 static void
tcsetpgrp_without_stopping(int fd,pid_t pgid)952 tcsetpgrp_without_stopping (int fd, pid_t pgid)
953 {
954 #ifdef SIGTTOU
955 sigset_t oldset;
956 block_input ();
957 block_tty_out_signal (&oldset);
958 tcsetpgrp (fd, pgid);
959 unblock_tty_out_signal (&oldset);
960 unblock_input ();
961 #endif
962 }
963
964 /* Split off the foreground process group to Emacs alone. When we are
965 in the foreground, but not started in our own process group,
966 redirect the tty device handle FD to point to our own process
967 group. FD must be the file descriptor of the controlling tty. */
968 static void
narrow_foreground_group(int fd)969 narrow_foreground_group (int fd)
970 {
971 if (inherited_pgroup && setpgid (0, 0) == 0)
972 tcsetpgrp_without_stopping (fd, getpid ());
973 }
974
975 /* Set the tty to our original foreground group. */
976 static void
widen_foreground_group(int fd)977 widen_foreground_group (int fd)
978 {
979 if (inherited_pgroup && setpgid (0, inherited_pgroup) == 0)
980 tcsetpgrp_without_stopping (fd, inherited_pgroup);
981 }
982
983 /* Getting and setting emacs_tty structures. */
984
985 /* Set *TC to the parameters associated with the terminal FD,
986 or clear it if the parameters are not available.
987 Return 0 on success, -1 on failure. */
988 int
emacs_get_tty(int fd,struct emacs_tty * settings)989 emacs_get_tty (int fd, struct emacs_tty *settings)
990 {
991 /* Retrieve the primary parameters - baud rate, character size, etcetera. */
992 memset (&settings->main, 0, sizeof (settings->main));
993 #ifdef DOS_NT
994 #ifdef WINDOWSNT
995 HANDLE h = (HANDLE)_get_osfhandle (fd);
996 DWORD console_mode;
997
998 if (h && h != INVALID_HANDLE_VALUE && GetConsoleMode (h, &console_mode))
999 {
1000 settings->main = console_mode;
1001 return 0;
1002 }
1003 #endif /* WINDOWSNT */
1004 return -1;
1005 #else /* !DOS_NT */
1006 /* We have those nifty POSIX tcmumbleattr functions. */
1007 return tcgetattr (fd, &settings->main);
1008 #endif
1009 }
1010
1011
1012 /* Set the parameters of the tty on FD according to the contents of
1013 *SETTINGS. If FLUSHP, discard input.
1014 Return 0 if all went well, and -1 (setting errno) if anything failed. */
1015
1016 int
emacs_set_tty(int fd,struct emacs_tty * settings,bool flushp)1017 emacs_set_tty (int fd, struct emacs_tty *settings, bool flushp)
1018 {
1019 /* Set the primary parameters - baud rate, character size, etcetera. */
1020 #ifdef DOS_NT
1021 #ifdef WINDOWSNT
1022 HANDLE h = (HANDLE)_get_osfhandle (fd);
1023
1024 if (h && h != INVALID_HANDLE_VALUE)
1025 {
1026 DWORD new_mode;
1027
1028 /* Assume the handle is open for input. */
1029 if (flushp)
1030 FlushConsoleInputBuffer (h);
1031 new_mode = settings->main;
1032 SetConsoleMode (h, new_mode);
1033 }
1034 #endif /* WINDOWSNT */
1035 #else /* !DOS_NT */
1036 int i;
1037 /* We have those nifty POSIX tcmumbleattr functions.
1038 William J. Smith <wjs@wiis.wang.com> writes:
1039 "POSIX 1003.1 defines tcsetattr to return success if it was
1040 able to perform any of the requested actions, even if some
1041 of the requested actions could not be performed.
1042 We must read settings back to ensure tty setup properly.
1043 AIX requires this to keep tty from hanging occasionally." */
1044 /* This make sure that we don't loop indefinitely in here. */
1045 for (i = 0 ; i < 10 ; i++)
1046 if (tcsetattr (fd, flushp ? TCSAFLUSH : TCSADRAIN, &settings->main) < 0)
1047 {
1048 if (errno == EINTR)
1049 continue;
1050 else
1051 return -1;
1052 }
1053 else
1054 {
1055 struct termios new;
1056
1057 memset (&new, 0, sizeof (new));
1058 /* Get the current settings, and see if they're what we asked for. */
1059 tcgetattr (fd, &new);
1060 /* We cannot use memcmp on the whole structure here because under
1061 * aix386 the termios structure has some reserved field that may
1062 * not be filled in.
1063 */
1064 if ( new.c_iflag == settings->main.c_iflag
1065 && new.c_oflag == settings->main.c_oflag
1066 && new.c_cflag == settings->main.c_cflag
1067 && new.c_lflag == settings->main.c_lflag
1068 && memcmp (new.c_cc, settings->main.c_cc, NCCS) == 0)
1069 break;
1070 else
1071 continue;
1072 }
1073 #endif
1074
1075 /* We have survived the tempest. */
1076 return 0;
1077 }
1078
1079
1080
1081 #ifdef F_SETOWN
1082 static int old_fcntl_owner[FD_SETSIZE];
1083 #endif /* F_SETOWN */
1084
1085 /* Initialize the terminal mode on all tty devices that are currently
1086 open. */
1087
1088 void
init_all_sys_modes(void)1089 init_all_sys_modes (void)
1090 {
1091 struct tty_display_info *tty;
1092 for (tty = tty_list; tty; tty = tty->next)
1093 init_sys_modes (tty);
1094 }
1095
1096 /* Initialize the terminal mode on the given tty device. */
1097
1098 void
init_sys_modes(struct tty_display_info * tty_out)1099 init_sys_modes (struct tty_display_info *tty_out)
1100 {
1101 struct emacs_tty tty;
1102 #ifndef DOS_NT
1103 Lisp_Object terminal;
1104 #endif
1105
1106 Vtty_erase_char = Qnil;
1107
1108 if (noninteractive)
1109 return;
1110
1111 if (!tty_out->output)
1112 return; /* The tty is suspended. */
1113
1114 narrow_foreground_group (fileno (tty_out->input));
1115
1116 if (! tty_out->old_tty)
1117 tty_out->old_tty = xmalloc (sizeof *tty_out->old_tty);
1118
1119 emacs_get_tty (fileno (tty_out->input), tty_out->old_tty);
1120
1121 tty = *tty_out->old_tty;
1122
1123 #if !defined (DOS_NT)
1124 XSETINT (Vtty_erase_char, tty.main.c_cc[VERASE]);
1125
1126 tty.main.c_iflag |= (IGNBRK); /* Ignore break condition */
1127 tty.main.c_iflag &= ~ICRNL; /* Disable map of CR to NL on input */
1128 #ifdef INLCR /* I'm just being cautious,
1129 since I can't check how widespread INLCR is--rms. */
1130 tty.main.c_iflag &= ~INLCR; /* Disable map of NL to CR on input */
1131 #endif
1132 #ifdef ISTRIP
1133 tty.main.c_iflag &= ~ISTRIP; /* don't strip 8th bit on input */
1134 #endif
1135 tty.main.c_lflag &= ~ECHO; /* Disable echo */
1136 tty.main.c_lflag &= ~ICANON; /* Disable erase/kill processing */
1137 #ifdef IEXTEN
1138 tty.main.c_lflag &= ~IEXTEN; /* Disable other editing characters. */
1139 #endif
1140 tty.main.c_lflag |= ISIG; /* Enable signals */
1141 if (tty_out->flow_control)
1142 {
1143 tty.main.c_iflag |= IXON; /* Enable start/stop output control */
1144 #ifdef IXANY
1145 tty.main.c_iflag &= ~IXANY;
1146 #endif /* IXANY */
1147 }
1148 else
1149 tty.main.c_iflag &= ~IXON; /* Disable start/stop output control */
1150 tty.main.c_oflag &= ~ONLCR; /* Disable map of NL to CR-NL
1151 on output */
1152 tty.main.c_oflag &= ~TAB3; /* Disable tab expansion */
1153 #ifdef CS8
1154 if (tty_out->meta_key)
1155 {
1156 tty.main.c_cflag |= CS8; /* allow 8th bit on input */
1157 tty.main.c_cflag &= ~PARENB;/* Don't check parity */
1158 }
1159 #endif
1160
1161 XSETTERMINAL(terminal, tty_out->terminal);
1162 if (!NILP (Fcontrolling_tty_p (terminal)))
1163 {
1164 tty.main.c_cc[VINTR] = quit_char; /* C-g (usually) gives SIGINT */
1165 /* Set up C-g for both SIGQUIT and SIGINT.
1166 We don't know which we will get, but we handle both alike
1167 so which one it really gives us does not matter. */
1168 tty.main.c_cc[VQUIT] = quit_char;
1169 }
1170 else
1171 {
1172 /* We normally don't get interrupt or quit signals from tty
1173 devices other than our controlling terminal; therefore,
1174 we must handle C-g as normal input. Unfortunately, this
1175 means that the interrupt and quit feature must be
1176 disabled on secondary ttys, or we would not even see the
1177 keypress.
1178
1179 Note that even though emacsclient could have special code
1180 to pass SIGINT to Emacs, we should _not_ enable
1181 interrupt/quit keys for emacsclient frames. This means
1182 that we can't break out of loops in C code from a
1183 secondary tty frame, but we can always decide what
1184 display the C-g came from, which is more important from a
1185 usability point of view. (Consider the case when two
1186 people work together using the same Emacs instance.) */
1187 tty.main.c_cc[VINTR] = CDISABLE;
1188 tty.main.c_cc[VQUIT] = CDISABLE;
1189 }
1190 tty.main.c_cc[VMIN] = 1; /* Input should wait for at least 1 char */
1191 tty.main.c_cc[VTIME] = 0; /* no matter how long that takes. */
1192 #ifdef VSWTCH
1193 tty.main.c_cc[VSWTCH] = CDISABLE; /* Turn off shell layering use
1194 of C-z */
1195 #endif /* VSWTCH */
1196
1197 #ifdef VSUSP
1198 tty.main.c_cc[VSUSP] = CDISABLE; /* Turn off handling of C-z. */
1199 #endif /* VSUSP */
1200 #ifdef V_DSUSP
1201 tty.main.c_cc[V_DSUSP] = CDISABLE; /* Turn off handling of C-y. */
1202 #endif /* V_DSUSP */
1203 #ifdef VDSUSP /* Some systems have VDSUSP, some have V_DSUSP. */
1204 tty.main.c_cc[VDSUSP] = CDISABLE;
1205 #endif /* VDSUSP */
1206 #ifdef VLNEXT
1207 tty.main.c_cc[VLNEXT] = CDISABLE;
1208 #endif /* VLNEXT */
1209 #ifdef VREPRINT
1210 tty.main.c_cc[VREPRINT] = CDISABLE;
1211 #endif /* VREPRINT */
1212 #ifdef VWERASE
1213 tty.main.c_cc[VWERASE] = CDISABLE;
1214 #endif /* VWERASE */
1215 #ifdef VDISCARD
1216 tty.main.c_cc[VDISCARD] = CDISABLE;
1217 #endif /* VDISCARD */
1218
1219 if (tty_out->flow_control)
1220 {
1221 #ifdef VSTART
1222 tty.main.c_cc[VSTART] = '\021';
1223 #endif /* VSTART */
1224 #ifdef VSTOP
1225 tty.main.c_cc[VSTOP] = '\023';
1226 #endif /* VSTOP */
1227 }
1228 else
1229 {
1230 #ifdef VSTART
1231 tty.main.c_cc[VSTART] = CDISABLE;
1232 #endif /* VSTART */
1233 #ifdef VSTOP
1234 tty.main.c_cc[VSTOP] = CDISABLE;
1235 #endif /* VSTOP */
1236 }
1237
1238 #ifdef AIX
1239 tty.main.c_cc[VSTRT] = CDISABLE;
1240 tty.main.c_cc[VSTOP] = CDISABLE;
1241 tty.main.c_cc[VSUSP] = CDISABLE;
1242 tty.main.c_cc[VDSUSP] = CDISABLE;
1243 if (tty_out->flow_control)
1244 {
1245 #ifdef VSTART
1246 tty.main.c_cc[VSTART] = '\021';
1247 #endif /* VSTART */
1248 #ifdef VSTOP
1249 tty.main.c_cc[VSTOP] = '\023';
1250 #endif /* VSTOP */
1251 }
1252 /* Also, PTY overloads NUL and BREAK.
1253 don't ignore break, but don't signal either, so it looks like NUL.
1254 This really serves a purpose only if running in an XTERM window
1255 or via TELNET or the like, but does no harm elsewhere. */
1256 tty.main.c_iflag &= ~IGNBRK;
1257 tty.main.c_iflag &= ~BRKINT;
1258 #endif
1259 #endif /* not DOS_NT */
1260
1261 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida, MW Aug 1993 */
1262 if (!tty_out->term_initted)
1263 internal_terminal_init ();
1264 dos_ttraw (tty_out);
1265 #endif
1266
1267 emacs_set_tty (fileno (tty_out->input), &tty, 0);
1268
1269 /* This code added to insure that, if flow-control is not to be used,
1270 we have an unlocked terminal at the start. */
1271
1272 #ifndef HAIKU /* On Haiku, TCXONC is a no-op and causes spurious
1273 compiler warnings. */
1274 #ifdef TCXONC
1275 if (!tty_out->flow_control) ioctl (fileno (tty_out->input), TCXONC, 1);
1276 #endif
1277 #endif /* HAIKU */
1278 #ifdef TIOCSTART
1279 if (!tty_out->flow_control) ioctl (fileno (tty_out->input), TIOCSTART, 0);
1280 #endif
1281
1282 #if !defined (DOS_NT)
1283 #ifdef TCOON
1284 if (!tty_out->flow_control) tcflow (fileno (tty_out->input), TCOON);
1285 #endif
1286 #endif
1287
1288 #ifdef F_GETOWN
1289 if (interrupt_input)
1290 {
1291 old_fcntl_owner[fileno (tty_out->input)] =
1292 fcntl (fileno (tty_out->input), F_GETOWN, 0);
1293 fcntl (fileno (tty_out->input), F_SETOWN, getpid ());
1294 init_sigio (fileno (tty_out->input));
1295 #ifdef HAVE_GPM
1296 if (gpm_tty == tty_out)
1297 {
1298 /* Arrange for mouse events to give us SIGIO signals. */
1299 fcntl (gpm_fd, F_SETOWN, getpid ());
1300 fcntl (gpm_fd, F_SETFL, fcntl (gpm_fd, F_GETFL, 0) | O_NONBLOCK);
1301 init_sigio (gpm_fd);
1302 }
1303 #endif /* HAVE_GPM */
1304 }
1305 #endif /* F_GETOWN */
1306
1307 setvbuf (tty_out->output, NULL, _IOFBF, BUFSIZ);
1308
1309 if (tty_out->terminal->set_terminal_modes_hook)
1310 tty_out->terminal->set_terminal_modes_hook (tty_out->terminal);
1311
1312 if (!tty_out->term_initted)
1313 {
1314 Lisp_Object tail, frame;
1315 FOR_EACH_FRAME (tail, frame)
1316 {
1317 /* XXX This needs to be revised. */
1318 if (FRAME_TERMCAP_P (XFRAME (frame))
1319 && FRAME_TTY (XFRAME (frame)) == tty_out)
1320 init_frame_faces (XFRAME (frame));
1321 }
1322 }
1323
1324 if (tty_out->term_initted && no_redraw_on_reenter)
1325 {
1326 /* We used to call "direct_output_forward_char(0)" here,
1327 but it's not clear why, since it may not do anything anyway. */
1328 }
1329 else
1330 {
1331 Lisp_Object tail, frame;
1332 frame_garbaged = 1;
1333 FOR_EACH_FRAME (tail, frame)
1334 {
1335 if ((FRAME_TERMCAP_P (XFRAME (frame))
1336 || FRAME_MSDOS_P (XFRAME (frame)))
1337 && FRAME_TTY (XFRAME (frame)) == tty_out)
1338 FRAME_GARBAGED_P (XFRAME (frame)) = 1;
1339 }
1340 }
1341
1342 tty_out->term_initted = 1;
1343 }
1344
1345 /* Return true if safe to use tabs in output.
1346 At the time this is called, init_sys_modes has not been done yet. */
1347
1348 bool
tabs_safe_p(int fd)1349 tabs_safe_p (int fd)
1350 {
1351 struct emacs_tty etty;
1352
1353 emacs_get_tty (fd, &etty);
1354 #ifndef DOS_NT
1355 #ifdef TABDLY
1356 return ((etty.main.c_oflag & TABDLY) != TAB3);
1357 #else /* not TABDLY */
1358 return 1;
1359 #endif /* not TABDLY */
1360 #else /* DOS_NT */
1361 return 0;
1362 #endif /* DOS_NT */
1363 }
1364
1365 /* Discard echoing. */
1366
1367 void
suppress_echo_on_tty(int fd)1368 suppress_echo_on_tty (int fd)
1369 {
1370 struct emacs_tty etty;
1371
1372 emacs_get_tty (fd, &etty);
1373 #ifdef DOS_NT
1374 /* Set raw input mode. */
1375 etty.main = 0;
1376 #else
1377 etty.main.c_lflag &= ~ICANON; /* Disable buffering */
1378 etty.main.c_lflag &= ~ECHO; /* Disable echoing */
1379 #endif /* ! WINDOWSNT */
1380 emacs_set_tty (fd, &etty, 0);
1381 }
1382
1383 /* Get terminal size from system.
1384 Store number of lines into *HEIGHTP and width into *WIDTHP.
1385 We store 0 if there's no valid information. */
1386
1387 void
get_tty_size(int fd,int * widthp,int * heightp)1388 get_tty_size (int fd, int *widthp, int *heightp)
1389 {
1390 #if defined TIOCGWINSZ
1391
1392 /* BSD-style. */
1393 struct winsize size;
1394
1395 if (ioctl (fd, TIOCGWINSZ, &size) == -1)
1396 *widthp = *heightp = 0;
1397 else
1398 {
1399 *widthp = size.ws_col;
1400 *heightp = size.ws_row;
1401 }
1402
1403 #elif defined TIOCGSIZE
1404
1405 /* SunOS - style. */
1406 struct ttysize size;
1407
1408 if (ioctl (fd, TIOCGSIZE, &size) == -1)
1409 *widthp = *heightp = 0;
1410 else
1411 {
1412 *widthp = size.ts_cols;
1413 *heightp = size.ts_lines;
1414 }
1415
1416 #elif defined WINDOWSNT
1417
1418 CONSOLE_SCREEN_BUFFER_INFO info;
1419 if (GetConsoleScreenBufferInfo (GetStdHandle (STD_OUTPUT_HANDLE), &info))
1420 {
1421 *widthp = info.srWindow.Right - info.srWindow.Left + 1;
1422 *heightp = info.srWindow.Bottom - info.srWindow.Top + 1;
1423 }
1424 else
1425 *widthp = *heightp = 0;
1426
1427 #elif defined MSDOS
1428
1429 *widthp = ScreenCols ();
1430 *heightp = ScreenRows ();
1431
1432 #else /* system doesn't know size */
1433
1434 *widthp = 0;
1435 *heightp = 0;
1436
1437 #endif
1438 }
1439
1440 /* Set the logical window size associated with descriptor FD
1441 to HEIGHT and WIDTH. This is used mainly with ptys.
1442 Return a negative value on failure. */
1443
1444 int
set_window_size(int fd,int height,int width)1445 set_window_size (int fd, int height, int width)
1446 {
1447 #ifdef TIOCSWINSZ
1448
1449 /* BSD-style. */
1450 struct winsize size;
1451 memset (&size, 0, sizeof (size));
1452 size.ws_row = height;
1453 size.ws_col = width;
1454
1455 return ioctl (fd, TIOCSWINSZ, &size);
1456
1457 #else
1458 #ifdef TIOCSSIZE
1459
1460 /* SunOS - style. */
1461 struct ttysize size;
1462 memset (&size, 0, sizeof (size));
1463 size.ts_lines = height;
1464 size.ts_cols = width;
1465
1466 return ioctl (fd, TIOCGSIZE, &size);
1467 #else
1468 return -1;
1469 #endif /* not SunOS-style */
1470 #endif /* not BSD-style */
1471 }
1472
1473
1474
1475 /* Prepare all terminal devices for exiting Emacs. */
1476
1477 void
reset_all_sys_modes(void)1478 reset_all_sys_modes (void)
1479 {
1480 struct tty_display_info *tty;
1481 for (tty = tty_list; tty; tty = tty->next)
1482 reset_sys_modes (tty);
1483 }
1484
1485 /* Prepare the terminal for closing it; move the cursor to the
1486 bottom of the frame, turn off interrupt-driven I/O, etc. */
1487
1488 void
reset_sys_modes(struct tty_display_info * tty_out)1489 reset_sys_modes (struct tty_display_info *tty_out)
1490 {
1491 if (noninteractive)
1492 {
1493 fflush (stdout);
1494 return;
1495 }
1496 if (!tty_out->term_initted)
1497 return;
1498
1499 if (!tty_out->output)
1500 return; /* The tty is suspended. */
1501
1502 /* Go to and clear the last line of the terminal. */
1503
1504 cmgoto (tty_out, FrameRows (tty_out) - 1, 0);
1505
1506 /* Code adapted from tty_clear_end_of_line. */
1507 if (tty_out->TS_clr_line)
1508 {
1509 emacs_tputs (tty_out, tty_out->TS_clr_line, 1, cmputc);
1510 }
1511 else
1512 { /* have to do it the hard way */
1513 tty_turn_off_insert (tty_out);
1514
1515 for (int i = cursorX (tty_out); i < FrameCols (tty_out) - 1; i++)
1516 putc (' ', tty_out->output);
1517 }
1518
1519 cmgoto (tty_out, FrameRows (tty_out) - 1, 0);
1520 fflush (tty_out->output);
1521
1522 if (tty_out->terminal->reset_terminal_modes_hook)
1523 tty_out->terminal->reset_terminal_modes_hook (tty_out->terminal);
1524
1525 /* Avoid possible loss of output when changing terminal modes. */
1526 while (tcdrain (fileno (tty_out->output)) != 0 && errno == EINTR)
1527 continue;
1528
1529 #ifndef DOS_NT
1530 # ifdef F_SETOWN
1531 if (interrupt_input)
1532 {
1533 reset_sigio (fileno (tty_out->input));
1534 fcntl (fileno (tty_out->input), F_SETOWN,
1535 old_fcntl_owner[fileno (tty_out->input)]);
1536 }
1537 # endif /* F_SETOWN */
1538 fcntl (fileno (tty_out->input), F_SETFL,
1539 fcntl (fileno (tty_out->input), F_GETFL, 0) & ~O_NONBLOCK);
1540 #endif
1541
1542 if (tty_out->old_tty)
1543 while (emacs_set_tty (fileno (tty_out->input),
1544 tty_out->old_tty, 0) < 0 && errno == EINTR)
1545 ;
1546
1547 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */
1548 dos_ttcooked ();
1549 #endif
1550
1551 widen_foreground_group (fileno (tty_out->input));
1552 }
1553
1554 #ifdef HAVE_PTYS
1555
1556 /* Set up the proper status flags for use of a pty. */
1557
1558 void
setup_pty(int fd)1559 setup_pty (int fd)
1560 {
1561 /* I'm told that TOICREMOTE does not mean control chars
1562 "can't be sent" but rather that they don't have
1563 input-editing or signaling effects.
1564 That should be good, because we have other ways
1565 to do those things in Emacs.
1566 However, telnet mode seems not to work on 4.2.
1567 So TIOCREMOTE is turned off now. */
1568
1569 /* Under hp-ux, if TIOCREMOTE is turned on, some calls
1570 will hang. In particular, the "timeout" feature (which
1571 causes a read to return if there is no data available)
1572 does this. Also it is known that telnet mode will hang
1573 in such a way that Emacs must be stopped (perhaps this
1574 is the same problem).
1575
1576 If TIOCREMOTE is turned off, then there is a bug in
1577 hp-ux which sometimes loses data. Apparently the
1578 code which blocks the master process when the internal
1579 buffer fills up does not work. Other than this,
1580 though, everything else seems to work fine.
1581
1582 Since the latter lossage is more benign, we may as well
1583 lose that way. -- cph */
1584 #ifdef FIONBIO
1585 #if defined (UNIX98_PTYS)
1586 {
1587 int on = 1;
1588 ioctl (fd, FIONBIO, &on);
1589 }
1590 #endif
1591 #endif
1592 }
1593 #endif /* HAVE_PTYS */
1594
1595 void
init_system_name(void)1596 init_system_name (void)
1597 {
1598 if (!build_details)
1599 {
1600 /* Set system-name to nil so that the build is deterministic. */
1601 Vsystem_name = Qnil;
1602 return;
1603 }
1604 char *hostname_alloc = NULL;
1605 char *hostname;
1606 #ifndef HAVE_GETHOSTNAME
1607 struct utsname uts;
1608 uname (&uts);
1609 hostname = uts.nodename;
1610 #else /* HAVE_GETHOSTNAME */
1611 char hostname_buf[256];
1612 ptrdiff_t hostname_size = sizeof hostname_buf;
1613 hostname = hostname_buf;
1614
1615 /* Try to get the host name; if the buffer is too short, try
1616 again. Apparently, the only indication gethostname gives of
1617 whether the buffer was large enough is the presence or absence
1618 of a '\0' in the string. Eech. */
1619 for (;;)
1620 {
1621 gethostname (hostname, hostname_size - 1);
1622 hostname[hostname_size - 1] = '\0';
1623
1624 /* Was the buffer large enough for the '\0'? */
1625 if (strlen (hostname) < hostname_size - 1)
1626 break;
1627
1628 hostname = hostname_alloc = xpalloc (hostname_alloc, &hostname_size, 1,
1629 min (PTRDIFF_MAX, SIZE_MAX), 1);
1630 }
1631 #endif /* HAVE_GETHOSTNAME */
1632 char *p;
1633 for (p = hostname; *p; p++)
1634 if (*p == ' ' || *p == '\t')
1635 *p = '-';
1636 if (! (STRINGP (Vsystem_name) && SBYTES (Vsystem_name) == p - hostname
1637 && strcmp (SSDATA (Vsystem_name), hostname) == 0))
1638 Vsystem_name = build_string (hostname);
1639 xfree (hostname_alloc);
1640 }
1641
1642 sigset_t empty_mask;
1643
1644 static struct sigaction process_fatal_action;
1645
1646 static int
emacs_sigaction_flags(void)1647 emacs_sigaction_flags (void)
1648 {
1649 #ifdef SA_RESTART
1650 /* SA_RESTART causes interruptible functions with timeouts (e.g.,
1651 'select') to reset their timeout on some platforms (e.g.,
1652 HP-UX 11), which is not what we want. Also, when Emacs is
1653 interactive, we don't want SA_RESTART because we need to poll
1654 for pending input so we need long-running syscalls to be interrupted
1655 after a signal that sets pending_signals.
1656
1657 Non-interactive keyboard input goes through stdio, where we
1658 always want restartable system calls. */
1659 if (noninteractive)
1660 return SA_RESTART;
1661 #endif
1662 return 0;
1663 }
1664
1665 /* Store into *ACTION a signal action suitable for Emacs, with handler
1666 HANDLER. */
1667 void
emacs_sigaction_init(struct sigaction * action,signal_handler_t handler)1668 emacs_sigaction_init (struct sigaction *action, signal_handler_t handler)
1669 {
1670 sigemptyset (&action->sa_mask);
1671
1672 /* When handling a signal, block nonfatal system signals that are caught
1673 by Emacs. This makes race conditions less likely. */
1674 sigaddset (&action->sa_mask, SIGALRM);
1675 #ifdef SIGCHLD
1676 sigaddset (&action->sa_mask, SIGCHLD);
1677 #endif
1678 #ifdef SIGDANGER
1679 sigaddset (&action->sa_mask, SIGDANGER);
1680 #endif
1681 #ifdef PROFILER_CPU_SUPPORT
1682 sigaddset (&action->sa_mask, SIGPROF);
1683 #endif
1684 #ifdef SIGWINCH
1685 sigaddset (&action->sa_mask, SIGWINCH);
1686 #endif
1687 if (! noninteractive)
1688 {
1689 sigaddset (&action->sa_mask, SIGINT);
1690 sigaddset (&action->sa_mask, SIGQUIT);
1691 #ifdef USABLE_SIGIO
1692 sigaddset (&action->sa_mask, SIGIO);
1693 #elif defined (USABLE_SIGPOLL)
1694 sigaddset (&action->sa_mask, SIGPOLL);
1695 #endif
1696 }
1697
1698 action->sa_handler = handler;
1699 action->sa_flags = emacs_sigaction_flags ();
1700 }
1701
1702 #ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
1703 static pthread_t main_thread_id;
1704 #endif
1705
1706 /* SIG has arrived at the current process. Deliver it to the main
1707 thread, which should handle it with HANDLER. (Delivering the
1708 signal to some other thread might not work if the other thread is
1709 about to exit.)
1710
1711 If we are on the main thread, handle the signal SIG with HANDLER.
1712 Otherwise, redirect the signal to the main thread, blocking it from
1713 this thread. POSIX says any thread can receive a signal that is
1714 associated with a process, process group, or asynchronous event.
1715 On GNU/Linux the main thread typically gets a process signal unless
1716 it's blocked, but other systems (FreeBSD at least) can deliver the
1717 signal to other threads. */
1718 void
deliver_process_signal(int sig,signal_handler_t handler)1719 deliver_process_signal (int sig, signal_handler_t handler)
1720 {
1721 /* Preserve errno, to avoid race conditions with signal handlers that
1722 might change errno. Races can occur even in single-threaded hosts. */
1723 int old_errno = errno;
1724
1725 bool on_main_thread = true;
1726 #ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
1727 if (! pthread_equal (pthread_self (), main_thread_id))
1728 {
1729 sigset_t blocked;
1730 sigemptyset (&blocked);
1731 sigaddset (&blocked, sig);
1732 pthread_sigmask (SIG_BLOCK, &blocked, 0);
1733 pthread_kill (main_thread_id, sig);
1734 on_main_thread = false;
1735 }
1736 #endif
1737 if (on_main_thread)
1738 handler (sig);
1739
1740 errno = old_errno;
1741 }
1742
1743 /* Static location to save a fatal backtrace in a thread.
1744 FIXME: If two subsidiary threads fail simultaneously, the resulting
1745 backtrace may be garbage. */
1746 enum { BACKTRACE_LIMIT_MAX = 500 };
1747 static void *thread_backtrace_buffer[BACKTRACE_LIMIT_MAX + 1];
1748 static int thread_backtrace_npointers;
1749
1750 /* SIG has arrived at the current thread.
1751 If we are on the main thread, handle the signal SIG with HANDLER.
1752 Otherwise, this is a fatal error in the handling thread. */
1753 static void
deliver_thread_signal(int sig,signal_handler_t handler)1754 deliver_thread_signal (int sig, signal_handler_t handler)
1755 {
1756 int old_errno = errno;
1757
1758 #ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
1759 if (! pthread_equal (pthread_self (), main_thread_id))
1760 {
1761 thread_backtrace_npointers
1762 = backtrace (thread_backtrace_buffer, BACKTRACE_LIMIT_MAX);
1763 sigaction (sig, &process_fatal_action, 0);
1764 pthread_kill (main_thread_id, sig);
1765
1766 /* Avoid further damage while the main thread is exiting. */
1767 while (1)
1768 sigsuspend (&empty_mask);
1769 }
1770 #endif
1771
1772 handler (sig);
1773 errno = old_errno;
1774 }
1775
1776 /* Handle bus errors, invalid instruction, etc. */
1777 static void
handle_fatal_signal(int sig)1778 handle_fatal_signal (int sig)
1779 {
1780 terminate_due_to_signal (sig, 40);
1781 }
1782
1783 static void
deliver_fatal_signal(int sig)1784 deliver_fatal_signal (int sig)
1785 {
1786 deliver_process_signal (sig, handle_fatal_signal);
1787 }
1788
1789 static void
deliver_fatal_thread_signal(int sig)1790 deliver_fatal_thread_signal (int sig)
1791 {
1792 deliver_thread_signal (sig, handle_fatal_signal);
1793 }
1794
1795 static AVOID
handle_arith_signal(int sig)1796 handle_arith_signal (int sig)
1797 {
1798 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
1799 xsignal0 (Qarith_error);
1800 }
1801
1802 #if defined HAVE_STACK_OVERFLOW_HANDLING && !defined WINDOWSNT
1803
1804 /* Alternate stack used by SIGSEGV handler below. */
1805
1806 /* Storage for the alternate signal stack.
1807 64 KiB is not too large for Emacs, and is large enough
1808 for all known platforms. Smaller sizes may run into trouble.
1809 For example, libsigsegv 2.6 through 2.8 have a bug where some
1810 architectures use more than the Linux default of an 8 KiB alternate
1811 stack when deciding if a fault was caused by stack overflow. */
1812 static max_align_t sigsegv_stack[(64 * 1024
1813 + sizeof (max_align_t) - 1)
1814 / sizeof (max_align_t)];
1815
1816
1817 /* Return true if SIGINFO indicates a stack overflow. */
1818
1819 static bool
stack_overflow(siginfo_t * siginfo)1820 stack_overflow (siginfo_t *siginfo)
1821 {
1822 if (!attempt_stack_overflow_recovery)
1823 return false;
1824
1825 /* In theory, a more-accurate heuristic can be obtained by using
1826 GNU/Linux pthread_getattr_np along with POSIX pthread_attr_getstack
1827 and pthread_attr_getguardsize to find the location and size of the
1828 guard area. In practice, though, these functions are so hard to
1829 use reliably that they're not worth bothering with. E.g., see:
1830 https://sourceware.org/bugzilla/show_bug.cgi?id=16291
1831 Other operating systems also have problems, e.g., Solaris's
1832 stack_violation function is tailor-made for this problem, but it
1833 doesn't work on Solaris 11.2 x86-64 with a 32-bit executable.
1834
1835 GNU libsigsegv is overkill for Emacs; otherwise it might be a
1836 candidate here. */
1837
1838 if (!siginfo)
1839 return false;
1840
1841 /* The faulting address. */
1842 char *addr = siginfo->si_addr;
1843 if (!addr)
1844 return false;
1845
1846 /* The known top and bottom of the stack. The actual stack may
1847 extend a bit beyond these boundaries. */
1848 char const *bot = stack_bottom;
1849 char const *top = current_thread->stack_top;
1850
1851 /* Log base 2 of the stack heuristic ratio. This ratio is the size
1852 of the known stack divided by the size of the guard area past the
1853 end of the stack top. The heuristic is that a bad address is
1854 considered to be a stack overflow if it occurs within
1855 stacksize>>LG_STACK_HEURISTIC bytes above the top of the known
1856 stack. This heuristic is not exactly correct but it's good
1857 enough in practice. */
1858 enum { LG_STACK_HEURISTIC = 8 };
1859
1860 if (bot < top)
1861 return 0 <= addr - top && addr - top < (top - bot) >> LG_STACK_HEURISTIC;
1862 else
1863 return 0 <= top - addr && top - addr < (bot - top) >> LG_STACK_HEURISTIC;
1864 }
1865
1866
1867 /* Attempt to recover from SIGSEGV caused by C stack overflow. */
1868
1869 static void
handle_sigsegv(int sig,siginfo_t * siginfo,void * arg)1870 handle_sigsegv (int sig, siginfo_t *siginfo, void *arg)
1871 {
1872 /* Hard GC error may lead to stack overflow caused by
1873 too nested calls to mark_object. No way to survive. */
1874 bool fatal = gc_in_progress;
1875
1876 #ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
1877 if (!fatal && !pthread_equal (pthread_self (), main_thread_id))
1878 fatal = true;
1879 #endif
1880
1881 if (!fatal && stack_overflow (siginfo))
1882 siglongjmp (return_to_command_loop, 1);
1883
1884 /* Otherwise we can't do anything with this. */
1885 deliver_fatal_thread_signal (sig);
1886 }
1887
1888 /* Return true if we have successfully set up SIGSEGV handler on alternate
1889 stack. Otherwise we just treat SIGSEGV among the rest of fatal signals. */
1890
1891 static bool
init_sigsegv(void)1892 init_sigsegv (void)
1893 {
1894 struct sigaction sa;
1895 stack_t ss;
1896
1897 ss.ss_sp = sigsegv_stack;
1898 ss.ss_size = sizeof (sigsegv_stack);
1899 ss.ss_flags = 0;
1900 if (sigaltstack (&ss, NULL) < 0)
1901 return 0;
1902
1903 sigfillset (&sa.sa_mask);
1904 sa.sa_sigaction = handle_sigsegv;
1905 sa.sa_flags = SA_SIGINFO | SA_ONSTACK | emacs_sigaction_flags ();
1906 if (sigaction (SIGSEGV, &sa, NULL) < 0)
1907 return 0;
1908
1909 return 1;
1910 }
1911
1912 #else /* not HAVE_STACK_OVERFLOW_HANDLING or WINDOWSNT */
1913
1914 static bool
init_sigsegv(void)1915 init_sigsegv (void)
1916 {
1917 return 0;
1918 }
1919
1920 #endif /* HAVE_STACK_OVERFLOW_HANDLING && !WINDOWSNT */
1921
1922 static void
deliver_arith_signal(int sig)1923 deliver_arith_signal (int sig)
1924 {
1925 deliver_thread_signal (sig, handle_arith_signal);
1926 }
1927
1928 #ifdef SIGDANGER
1929
1930 /* Handler for SIGDANGER. */
1931 static void
handle_danger_signal(int sig)1932 handle_danger_signal (int sig)
1933 {
1934 malloc_warning ("Operating system warns that virtual memory is running low.\n");
1935
1936 /* It might be unsafe to call do_auto_save now. */
1937 force_auto_save_soon ();
1938 }
1939
1940 static void
deliver_danger_signal(int sig)1941 deliver_danger_signal (int sig)
1942 {
1943 deliver_process_signal (sig, handle_danger_signal);
1944 }
1945 #endif
1946
1947 /* Treat SIG as a terminating signal, unless it is already ignored and
1948 we are in --batch mode. Among other things, this makes nohup work. */
1949 static void
maybe_fatal_sig(int sig)1950 maybe_fatal_sig (int sig)
1951 {
1952 bool catch_sig = !noninteractive;
1953 if (!catch_sig)
1954 {
1955 struct sigaction old_action;
1956 sigaction (sig, 0, &old_action);
1957 catch_sig = old_action.sa_handler != SIG_IGN;
1958 }
1959 if (catch_sig)
1960 sigaction (sig, &process_fatal_action, 0);
1961 }
1962
1963 void
init_signals(void)1964 init_signals (void)
1965 {
1966 struct sigaction thread_fatal_action;
1967 struct sigaction action;
1968
1969 sigemptyset (&empty_mask);
1970
1971 #ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
1972 main_thread_id = pthread_self ();
1973 #endif
1974
1975 /* Don't alter signal handlers if dumping. On some machines,
1976 changing signal handlers sets static data that would make signals
1977 fail to work right when the dumped Emacs is run. */
1978 if (will_dump_p ())
1979 return;
1980
1981 sigfillset (&process_fatal_action.sa_mask);
1982 process_fatal_action.sa_handler = deliver_fatal_signal;
1983 process_fatal_action.sa_flags = emacs_sigaction_flags ();
1984
1985 sigfillset (&thread_fatal_action.sa_mask);
1986 thread_fatal_action.sa_handler = deliver_fatal_thread_signal;
1987 thread_fatal_action.sa_flags = process_fatal_action.sa_flags;
1988
1989 /* SIGINT may need special treatment on MS-Windows. See
1990 https://lists.gnu.org/r/emacs-devel/2010-09/msg01062.html
1991 Please update the doc of kill-emacs, kill-emacs-hook, and
1992 NEWS if you change this. */
1993
1994 maybe_fatal_sig (SIGHUP);
1995 maybe_fatal_sig (SIGINT);
1996 maybe_fatal_sig (SIGTERM);
1997
1998 /* Emacs checks for write errors, so it can safely ignore SIGPIPE.
1999 However, in batch mode leave SIGPIPE alone, as that causes Emacs
2000 to behave more like typical batch applications do. */
2001 if (! noninteractive)
2002 signal (SIGPIPE, SIG_IGN);
2003
2004 sigaction (SIGQUIT, &process_fatal_action, 0);
2005 sigaction (SIGILL, &thread_fatal_action, 0);
2006 sigaction (SIGTRAP, &thread_fatal_action, 0);
2007
2008 /* Typically SIGFPE is thread-specific and is fatal, like SIGILL.
2009 But on a non-IEEE host SIGFPE can come from a trap in the Lisp
2010 interpreter's floating point operations, so treat SIGFPE as an
2011 arith-error if it arises in the main thread. */
2012 if (IEEE_FLOATING_POINT)
2013 sigaction (SIGFPE, &thread_fatal_action, 0);
2014 else
2015 {
2016 emacs_sigaction_init (&action, deliver_arith_signal);
2017 sigaction (SIGFPE, &action, 0);
2018 }
2019
2020 #ifdef SIGUSR1
2021 add_user_signal (SIGUSR1, "sigusr1");
2022 #endif
2023 #ifdef SIGUSR2
2024 add_user_signal (SIGUSR2, "sigusr2");
2025 #endif
2026 sigaction (SIGABRT, &thread_fatal_action, 0);
2027 #ifdef SIGPRE
2028 sigaction (SIGPRE, &thread_fatal_action, 0);
2029 #endif
2030 #ifdef SIGORE
2031 sigaction (SIGORE, &thread_fatal_action, 0);
2032 #endif
2033 #ifdef SIGUME
2034 sigaction (SIGUME, &thread_fatal_action, 0);
2035 #endif
2036 #ifdef SIGDLK
2037 sigaction (SIGDLK, &process_fatal_action, 0);
2038 #endif
2039 #ifdef SIGCPULIM
2040 sigaction (SIGCPULIM, &process_fatal_action, 0);
2041 #endif
2042 #ifdef SIGIOT
2043 sigaction (SIGIOT, &thread_fatal_action, 0);
2044 #endif
2045 #ifdef SIGEMT
2046 sigaction (SIGEMT, &thread_fatal_action, 0);
2047 #endif
2048 #ifdef SIGBUS
2049 sigaction (SIGBUS, &thread_fatal_action, 0);
2050 #endif
2051 if (!init_sigsegv ())
2052 sigaction (SIGSEGV, &thread_fatal_action, 0);
2053 #ifdef SIGSYS
2054 sigaction (SIGSYS, &thread_fatal_action, 0);
2055 #endif
2056 sigaction (SIGTERM, &process_fatal_action, 0);
2057 #ifdef SIGPROF
2058 signal (SIGPROF, SIG_IGN);
2059 #endif
2060 #ifdef SIGVTALRM
2061 sigaction (SIGVTALRM, &process_fatal_action, 0);
2062 #endif
2063 #ifdef SIGXCPU
2064 sigaction (SIGXCPU, &process_fatal_action, 0);
2065 #endif
2066 #ifdef SIGXFSZ
2067 sigaction (SIGXFSZ, &process_fatal_action, 0);
2068 #endif
2069
2070 #ifdef SIGDANGER
2071 /* This just means available memory is getting low. */
2072 emacs_sigaction_init (&action, deliver_danger_signal);
2073 sigaction (SIGDANGER, &action, 0);
2074 #endif
2075
2076 /* AIX-specific signals. */
2077 #ifdef SIGGRANT
2078 sigaction (SIGGRANT, &process_fatal_action, 0);
2079 #endif
2080 #ifdef SIGMIGRATE
2081 sigaction (SIGMIGRATE, &process_fatal_action, 0);
2082 #endif
2083 #ifdef SIGMSG
2084 sigaction (SIGMSG, &process_fatal_action, 0);
2085 #endif
2086 #ifdef SIGRETRACT
2087 sigaction (SIGRETRACT, &process_fatal_action, 0);
2088 #endif
2089 #ifdef SIGSAK
2090 sigaction (SIGSAK, &process_fatal_action, 0);
2091 #endif
2092 #ifdef SIGSOUND
2093 sigaction (SIGSOUND, &process_fatal_action, 0);
2094 #endif
2095 #ifdef SIGTALRM
2096 sigaction (SIGTALRM, &thread_fatal_action, 0);
2097 #endif
2098 }
2099
2100 #ifndef HAVE_RANDOM
2101 #ifdef random
2102 #define HAVE_RANDOM
2103 #endif
2104 #endif
2105
2106 /* Figure out how many bits the system's random number generator uses.
2107 `random' and `lrand48' are assumed to return 31 usable bits.
2108 BSD `rand' returns a 31 bit value but the low order bits are unusable;
2109 so we'll shift it and treat it like the 15-bit USG `rand'. */
2110
2111 #ifndef RAND_BITS
2112 # ifdef HAVE_RANDOM
2113 # define RAND_BITS 31
2114 # else /* !HAVE_RANDOM */
2115 # ifdef HAVE_LRAND48
2116 # define RAND_BITS 31
2117 # define random lrand48
2118 # else /* !HAVE_LRAND48 */
2119 # define RAND_BITS 15
2120 # if RAND_MAX == 32767
2121 # define random rand
2122 # else /* RAND_MAX != 32767 */
2123 # if RAND_MAX == 2147483647
2124 # define random() (rand () >> 16)
2125 # else /* RAND_MAX != 2147483647 */
2126 # ifdef USG
2127 # define random rand
2128 # else
2129 # define random() (rand () >> 16)
2130 # endif /* !USG */
2131 # endif /* RAND_MAX != 2147483647 */
2132 # endif /* RAND_MAX != 32767 */
2133 # endif /* !HAVE_LRAND48 */
2134 # endif /* !HAVE_RANDOM */
2135 #endif /* !RAND_BITS */
2136
2137 #ifdef HAVE_RANDOM
2138 typedef unsigned int random_seed;
set_random_seed(random_seed arg)2139 static void set_random_seed (random_seed arg) { srandom (arg); }
2140 #elif defined HAVE_LRAND48
2141 typedef long int random_seed;
set_random_seed(random_seed arg)2142 static void set_random_seed (random_seed arg) { srand48 (arg); }
2143 #else
2144 typedef unsigned int random_seed;
set_random_seed(random_seed arg)2145 static void set_random_seed (random_seed arg) { srand (arg); }
2146 #endif
2147
2148 void
seed_random(void * seed,ptrdiff_t seed_size)2149 seed_random (void *seed, ptrdiff_t seed_size)
2150 {
2151 random_seed arg = 0;
2152 unsigned char *argp = (unsigned char *) &arg;
2153 unsigned char *seedp = seed;
2154 for (ptrdiff_t i = 0; i < seed_size; i++)
2155 argp[i % sizeof arg] ^= seedp[i];
2156 set_random_seed (arg);
2157 }
2158
2159 void
init_random(void)2160 init_random (void)
2161 {
2162 random_seed v;
2163 bool success = false;
2164
2165 /* First, try seeding the PRNG from the operating system's entropy
2166 source. This approach is both fast and secure. */
2167 #ifdef WINDOWSNT
2168 /* FIXME: Perhaps getrandom can be used here too? */
2169 success = w32_init_random (&v, sizeof v) == 0;
2170 #else
2171 verify (sizeof v <= 256);
2172 success = getrandom (&v, sizeof v, 0) == sizeof v;
2173 #endif
2174
2175 /* If that didn't work, just use the current time value and PID.
2176 It's at least better than XKCD 221. */
2177 if (!success)
2178 {
2179 struct timespec t = current_timespec ();
2180 v = getpid () ^ t.tv_sec ^ t.tv_nsec;
2181 }
2182
2183 set_random_seed (v);
2184 }
2185
2186 /*
2187 * Return a nonnegative random integer out of whatever we've got.
2188 * It contains enough bits to make a random (signed) Emacs fixnum.
2189 * This suffices even for a 64-bit architecture with a 15-bit rand.
2190 */
2191 EMACS_INT
get_random(void)2192 get_random (void)
2193 {
2194 EMACS_UINT val = 0;
2195 int i;
2196 for (i = 0; i < (FIXNUM_BITS + RAND_BITS - 1) / RAND_BITS; i++)
2197 val = (random () ^ (val << RAND_BITS)
2198 ^ (val >> (EMACS_INT_WIDTH - RAND_BITS)));
2199 val ^= val >> (EMACS_INT_WIDTH - FIXNUM_BITS);
2200 return val & INTMASK;
2201 }
2202
2203 #ifndef HAVE_SNPRINTF
2204 /* Approximate snprintf as best we can on ancient hosts that lack it. */
2205 int
snprintf(char * buf,size_t bufsize,char const * format,...)2206 snprintf (char *buf, size_t bufsize, char const *format, ...)
2207 {
2208 ptrdiff_t size = min (bufsize, PTRDIFF_MAX);
2209 ptrdiff_t nbytes = size - 1;
2210 va_list ap;
2211
2212 if (size)
2213 {
2214 va_start (ap, format);
2215 nbytes = doprnt (buf, size, format, 0, ap);
2216 va_end (ap);
2217 }
2218
2219 if (nbytes == size - 1)
2220 {
2221 /* Calculate the length of the string that would have been created
2222 had the buffer been large enough. */
2223 char stackbuf[4000];
2224 char *b = stackbuf;
2225 ptrdiff_t bsize = sizeof stackbuf;
2226 va_start (ap, format);
2227 nbytes = evxprintf (&b, &bsize, stackbuf, -1, format, ap);
2228 va_end (ap);
2229 if (b != stackbuf)
2230 xfree (b);
2231 }
2232
2233 if (INT_MAX < nbytes)
2234 {
2235 #ifdef EOVERFLOW
2236 errno = EOVERFLOW;
2237 #else
2238 errno = EDOM;
2239 #endif
2240 return -1;
2241 }
2242 return nbytes;
2243 }
2244 #endif
2245
2246 /* If a backtrace is available, output the top lines of it to stderr.
2247 Do not output more than BACKTRACE_LIMIT or BACKTRACE_LIMIT_MAX lines.
2248 This function may be called from a signal handler, so it should
2249 not invoke async-unsafe functions like malloc.
2250
2251 If BACKTRACE_LIMIT is -1, initialize tables that 'backtrace' uses
2252 but do not output anything. This avoids some problems that can
2253 otherwise occur if the malloc arena is corrupted before 'backtrace'
2254 is called, since 'backtrace' may call malloc if the tables are not
2255 initialized.
2256
2257 If the static variable THREAD_BACKTRACE_NPOINTERS is nonzero, a
2258 fatal error has occurred in some other thread; generate a thread
2259 backtrace instead, ignoring BACKTRACE_LIMIT. */
2260 void
emacs_backtrace(int backtrace_limit)2261 emacs_backtrace (int backtrace_limit)
2262 {
2263 void *main_backtrace_buffer[BACKTRACE_LIMIT_MAX + 1];
2264 int bounded_limit = min (backtrace_limit, BACKTRACE_LIMIT_MAX);
2265 void *buffer;
2266 int npointers;
2267
2268 if (thread_backtrace_npointers)
2269 {
2270 buffer = thread_backtrace_buffer;
2271 npointers = thread_backtrace_npointers;
2272 }
2273 else
2274 {
2275 buffer = main_backtrace_buffer;
2276
2277 /* Work around 'backtrace' bug; see Bug#19959 and glibc bug#18084. */
2278 if (bounded_limit < 0)
2279 {
2280 backtrace (buffer, 1);
2281 return;
2282 }
2283
2284 npointers = backtrace (buffer, bounded_limit + 1);
2285 }
2286
2287 if (npointers)
2288 {
2289 emacs_write (STDERR_FILENO, "Backtrace:\n", 11);
2290 backtrace_symbols_fd (buffer, npointers, STDERR_FILENO);
2291 if (bounded_limit < npointers)
2292 emacs_write (STDERR_FILENO, "...\n", 4);
2293 }
2294 }
2295
2296 #ifndef HAVE_NTGUI
2297 void
emacs_abort(void)2298 emacs_abort (void)
2299 {
2300 terminate_due_to_signal (SIGABRT, 40);
2301 }
2302 #endif
2303
2304 /* Assuming the directory DIRFD, store information about FILENAME into *ST,
2305 using FLAGS to control how the status is obtained.
2306 Do not fail merely because fetching info was interrupted by a signal.
2307 Allow the user to quit.
2308
2309 The type of ST is void * instead of struct stat * because the
2310 latter type would be problematic in lisp.h. Some platforms may
2311 play tricks like "#define stat stat64" in <sys/stat.h>, and lisp.h
2312 does not include <sys/stat.h>. */
2313
2314 int
emacs_fstatat(int dirfd,char const * filename,void * st,int flags)2315 emacs_fstatat (int dirfd, char const *filename, void *st, int flags)
2316 {
2317 int r;
2318 while ((r = fstatat (dirfd, filename, st, flags)) != 0 && errno == EINTR)
2319 maybe_quit ();
2320 return r;
2321 }
2322
2323 /* Assuming the directory DIRFD, open FILE for Emacs use,
2324 using open flags OFLAGS and mode MODE.
2325 Use binary I/O on systems that care about text vs binary I/O.
2326 Arrange for subprograms to not inherit the file descriptor.
2327 Prefer a method that is multithread-safe, if available.
2328 Do not fail merely because the open was interrupted by a signal.
2329 Allow the user to quit. */
2330
2331 int
emacs_openat(int dirfd,char const * file,int oflags,int mode)2332 emacs_openat (int dirfd, char const *file, int oflags, int mode)
2333 {
2334 int fd;
2335 if (! (oflags & O_TEXT))
2336 oflags |= O_BINARY;
2337 oflags |= O_CLOEXEC;
2338 while ((fd = openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR)
2339 maybe_quit ();
2340 return fd;
2341 }
2342
2343 int
emacs_open(char const * file,int oflags,int mode)2344 emacs_open (char const *file, int oflags, int mode)
2345 {
2346 return emacs_openat (AT_FDCWD, file, oflags, mode);
2347 }
2348
2349 /* Same as above, but doesn't allow the user to quit. */
2350
2351 static int
emacs_openat_noquit(int dirfd,const char * file,int oflags,int mode)2352 emacs_openat_noquit (int dirfd, const char *file, int oflags,
2353 int mode)
2354 {
2355 int fd;
2356 if (! (oflags & O_TEXT))
2357 oflags |= O_BINARY;
2358 oflags |= O_CLOEXEC;
2359 do
2360 fd = openat (dirfd, file, oflags, mode);
2361 while (fd < 0 && errno == EINTR);
2362 return fd;
2363 }
2364
2365 int
emacs_open_noquit(char const * file,int oflags,int mode)2366 emacs_open_noquit (char const *file, int oflags, int mode)
2367 {
2368 return emacs_openat_noquit (AT_FDCWD, file, oflags, mode);
2369 }
2370
2371 /* Open FILE as a stream for Emacs use, with mode MODE.
2372 Act like emacs_open with respect to threads, signals, and quits. */
2373
2374 FILE *
emacs_fopen(char const * file,char const * mode)2375 emacs_fopen (char const *file, char const *mode)
2376 {
2377 int fd, omode, oflags;
2378 int bflag = 0;
2379 char const *m = mode;
2380
2381 switch (*m++)
2382 {
2383 case 'r': omode = O_RDONLY; oflags = 0; break;
2384 case 'w': omode = O_WRONLY; oflags = O_CREAT | O_TRUNC; break;
2385 case 'a': omode = O_WRONLY; oflags = O_CREAT | O_APPEND; break;
2386 default: emacs_abort ();
2387 }
2388
2389 while (*m)
2390 switch (*m++)
2391 {
2392 case '+': omode = O_RDWR; break;
2393 case 't': bflag = O_TEXT; break;
2394 default: /* Ignore. */ break;
2395 }
2396
2397 fd = emacs_open (file, omode | oflags | bflag, 0666);
2398 return fd < 0 ? 0 : fdopen (fd, mode);
2399 }
2400
2401 /* Create a pipe for Emacs use. */
2402
2403 int
emacs_pipe(int fd[2])2404 emacs_pipe (int fd[2])
2405 {
2406 #ifdef MSDOS
2407 return pipe (fd);
2408 #else /* !MSDOS */
2409 return pipe2 (fd, O_BINARY | O_CLOEXEC);
2410 #endif /* !MSDOS */
2411 }
2412
2413 /* Approximate posix_close and POSIX_CLOSE_RESTART well enough for Emacs.
2414 For the background behind this mess, please see Austin Group defect 529
2415 <http://austingroupbugs.net/view.php?id=529>. */
2416
2417 #ifndef POSIX_CLOSE_RESTART
2418 # define POSIX_CLOSE_RESTART 1
2419 static int
posix_close(int fd,int flag)2420 posix_close (int fd, int flag)
2421 {
2422 /* Only the POSIX_CLOSE_RESTART case is emulated. */
2423 eassert (flag == POSIX_CLOSE_RESTART);
2424
2425 /* Things are tricky if close (fd) returns -1 with errno == EINTR
2426 on a system that does not define POSIX_CLOSE_RESTART.
2427
2428 In this case, in some systems (e.g., GNU/Linux, AIX) FD is
2429 closed, and retrying the close could inadvertently close a file
2430 descriptor allocated by some other thread. In other systems
2431 (e.g., HP/UX) FD is not closed. And in still other systems
2432 (e.g., macOS, Solaris), maybe FD is closed, maybe not, and in a
2433 multithreaded program there can be no way to tell.
2434
2435 So, in this case, pretend that the close succeeded. This works
2436 well on systems like GNU/Linux that close FD. Although it may
2437 leak a file descriptor on other systems, the leak is unlikely and
2438 it's better to leak than to close a random victim. */
2439 return close (fd) == 0 || errno == EINTR ? 0 : -1;
2440 }
2441 #endif
2442
2443 /* Close FD, retrying if interrupted. If successful, return 0;
2444 otherwise, return -1 and set errno to a non-EINTR value. Consider
2445 an EINPROGRESS error to be successful, as that's merely a signal
2446 arriving. FD is always closed when this function returns, even
2447 when it returns -1.
2448
2449 Do not call this function if FD is nonnegative and might already be closed,
2450 as that might close an innocent victim opened by some other thread. */
2451
2452 int
emacs_close(int fd)2453 emacs_close (int fd)
2454 {
2455 while (1)
2456 {
2457 int r = posix_close (fd, POSIX_CLOSE_RESTART);
2458 if (r == 0)
2459 return r;
2460 if (!POSIX_CLOSE_RESTART || errno != EINTR)
2461 {
2462 eassert (errno != EBADF || fd < 0);
2463 return errno == EINPROGRESS ? 0 : r;
2464 }
2465 }
2466 }
2467
2468 /* Maximum number of bytes to read or write in a single system call.
2469 This works around a serious bug in Linux kernels before 2.6.16; see
2470 <https://bugzilla.redhat.com/show_bug.cgi?format=multiple&id=612839>.
2471 It's likely to work around similar bugs in other operating systems, so do it
2472 on all platforms. Round INT_MAX down to a page size, with the conservative
2473 assumption that page sizes are at most 2**18 bytes (any kernel with a
2474 page size larger than that shouldn't have the bug). */
2475 #ifndef MAX_RW_COUNT
2476 #define MAX_RW_COUNT (INT_MAX >> 18 << 18)
2477 #endif
2478
2479 /* Verify that MAX_RW_COUNT fits in the relevant standard types. */
2480 #ifndef SSIZE_MAX
2481 # define SSIZE_MAX TYPE_MAXIMUM (ssize_t)
2482 #endif
2483 verify (MAX_RW_COUNT <= PTRDIFF_MAX);
2484 verify (MAX_RW_COUNT <= SIZE_MAX);
2485 verify (MAX_RW_COUNT <= SSIZE_MAX);
2486
2487 #ifdef WINDOWSNT
2488 /* Verify that Emacs read requests cannot cause trouble, even in
2489 64-bit builds. The last argument of 'read' is 'unsigned int', and
2490 the return value's type (see 'sys_read') is 'int'. */
2491 verify (MAX_RW_COUNT <= INT_MAX);
2492 verify (MAX_RW_COUNT <= UINT_MAX);
2493 #endif
2494
2495 /* Read from FD to a buffer BUF with size NBYTE.
2496 If interrupted, process any quits and pending signals immediately
2497 if INTERRUPTIBLE, and then retry the read unless quitting.
2498 Return the number of bytes read, which might be less than NBYTE.
2499 On error, set errno to a value other than EINTR, and return -1. */
2500 static ptrdiff_t
emacs_intr_read(int fd,void * buf,ptrdiff_t nbyte,bool interruptible)2501 emacs_intr_read (int fd, void *buf, ptrdiff_t nbyte, bool interruptible)
2502 {
2503 /* No caller should ever pass a too-large size to emacs_read. */
2504 eassert (nbyte <= MAX_RW_COUNT);
2505
2506 ssize_t result;
2507
2508 do
2509 {
2510 if (interruptible)
2511 maybe_quit ();
2512 result = read (fd, buf, nbyte);
2513 }
2514 while (result < 0 && errno == EINTR);
2515
2516 return result;
2517 }
2518
2519 /* Read from FD to a buffer BUF with size NBYTE.
2520 If interrupted, retry the read. Return the number of bytes read,
2521 which might be less than NBYTE. On error, set errno to a value
2522 other than EINTR, and return -1. */
2523 ptrdiff_t
emacs_read(int fd,void * buf,ptrdiff_t nbyte)2524 emacs_read (int fd, void *buf, ptrdiff_t nbyte)
2525 {
2526 return emacs_intr_read (fd, buf, nbyte, false);
2527 }
2528
2529 /* Like emacs_read, but also process quits and pending signals. */
2530 ptrdiff_t
emacs_read_quit(int fd,void * buf,ptrdiff_t nbyte)2531 emacs_read_quit (int fd, void *buf, ptrdiff_t nbyte)
2532 {
2533 return emacs_intr_read (fd, buf, nbyte, true);
2534 }
2535
2536 /* Write to FILEDES from a buffer BUF with size NBYTE, retrying if
2537 interrupted or if a partial write occurs. Process any quits
2538 immediately if INTERRUPTIBLE is positive, and process any pending
2539 signals immediately if INTERRUPTIBLE is nonzero. Return the number
2540 of bytes written; if this is less than NBYTE, set errno to a value
2541 other than EINTR. */
2542 static ptrdiff_t
emacs_full_write(int fd,char const * buf,ptrdiff_t nbyte,int interruptible)2543 emacs_full_write (int fd, char const *buf, ptrdiff_t nbyte,
2544 int interruptible)
2545 {
2546 ptrdiff_t bytes_written = 0;
2547
2548 while (nbyte > 0)
2549 {
2550 ssize_t n = write (fd, buf, min (nbyte, MAX_RW_COUNT));
2551
2552 if (n < 0)
2553 {
2554 if (errno != EINTR)
2555 break;
2556
2557 if (interruptible)
2558 {
2559 if (0 < interruptible)
2560 maybe_quit ();
2561 if (pending_signals)
2562 process_pending_signals ();
2563 }
2564 }
2565 else
2566 {
2567 buf += n;
2568 nbyte -= n;
2569 bytes_written += n;
2570 }
2571 }
2572
2573 return bytes_written;
2574 }
2575
2576 /* Write to FD from a buffer BUF with size NBYTE, retrying if
2577 interrupted or if a partial write occurs. Do not process quits or
2578 pending signals. Return the number of bytes written, setting errno
2579 if this is less than NBYTE. */
2580 ptrdiff_t
emacs_write(int fd,void const * buf,ptrdiff_t nbyte)2581 emacs_write (int fd, void const *buf, ptrdiff_t nbyte)
2582 {
2583 return emacs_full_write (fd, buf, nbyte, 0);
2584 }
2585
2586 /* Like emacs_write, but also process pending signals. */
2587 ptrdiff_t
emacs_write_sig(int fd,void const * buf,ptrdiff_t nbyte)2588 emacs_write_sig (int fd, void const *buf, ptrdiff_t nbyte)
2589 {
2590 return emacs_full_write (fd, buf, nbyte, -1);
2591 }
2592
2593 /* Like emacs_write, but also process quits and pending signals. */
2594 ptrdiff_t
emacs_write_quit(int fd,void const * buf,ptrdiff_t nbyte)2595 emacs_write_quit (int fd, void const *buf, ptrdiff_t nbyte)
2596 {
2597 return emacs_full_write (fd, buf, nbyte, 1);
2598 }
2599
2600 /* Write a diagnostic to standard error that contains MESSAGE and a
2601 string derived from errno. Preserve errno. Do not buffer stderr.
2602 Do not process quits or pending signals if interrupted. */
2603 void
emacs_perror(char const * message)2604 emacs_perror (char const *message)
2605 {
2606 int err = errno;
2607 char const *error_string = emacs_strerror (err);
2608 char const *command = (initial_argv && initial_argv[0]
2609 ? initial_argv[0] : "emacs");
2610 /* Write it out all at once, if it's short; this is less likely to
2611 be interleaved with other output. */
2612 char buf[min (PIPE_BUF, MAX_ALLOCA)];
2613 int nbytes = snprintf (buf, sizeof buf, "%s: %s: %s\n",
2614 command, message, error_string);
2615 if (0 <= nbytes && nbytes < sizeof buf)
2616 emacs_write (STDERR_FILENO, buf, nbytes);
2617 else
2618 {
2619 emacs_write (STDERR_FILENO, command, strlen (command));
2620 emacs_write (STDERR_FILENO, ": ", 2);
2621 emacs_write (STDERR_FILENO, message, strlen (message));
2622 emacs_write (STDERR_FILENO, ": ", 2);
2623 emacs_write (STDERR_FILENO, error_string, strlen (error_string));
2624 emacs_write (STDERR_FILENO, "\n", 1);
2625 }
2626 errno = err;
2627 }
2628
2629 /* Rename directory SRCFD's entry SRC to directory DSTFD's entry DST.
2630 This is like renameat except that it fails if DST already exists,
2631 or if this operation is not supported atomically. Return 0 if
2632 successful, -1 (setting errno) otherwise. */
2633 int
renameat_noreplace(int srcfd,char const * src,int dstfd,char const * dst)2634 renameat_noreplace (int srcfd, char const *src, int dstfd, char const *dst)
2635 {
2636 #if defined SYS_renameat2 && defined RENAME_NOREPLACE
2637 return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE);
2638 #elif defined CYGWIN && defined RENAME_NOREPLACE
2639 return renameat2 (srcfd, src, dstfd, dst, RENAME_NOREPLACE);
2640 #elif defined RENAME_EXCL
2641 return renameatx_np (srcfd, src, dstfd, dst, RENAME_EXCL);
2642 #else
2643 # ifdef WINDOWSNT
2644 if (srcfd == AT_FDCWD && dstfd == AT_FDCWD)
2645 return sys_rename_replace (src, dst, 0);
2646 # endif
2647 errno = ENOSYS;
2648 return -1;
2649 #endif
2650 }
2651
2652 /* Like strsignal, except async-signal-safe, and this function
2653 returns a string in the C locale rather than the current locale. */
2654 char const *
safe_strsignal(int code)2655 safe_strsignal (int code)
2656 {
2657 char const *signame = sigdescr_np (code);
2658
2659 if (! signame)
2660 signame = "Unknown signal";
2661
2662 return signame;
2663 }
2664
2665 /* Output to stderr. */
2666
2667 /* Return the error output stream. */
2668 static FILE *
errstream(void)2669 errstream (void)
2670 {
2671 FILE *err = buferr;
2672 if (!err)
2673 return stderr;
2674 fflush_unlocked (stderr);
2675 return err;
2676 }
2677
2678 /* These functions are like fputc, vfprintf, and fwrite,
2679 except that they output to stderr and buffer better on
2680 platforms that support line buffering. This avoids interleaving
2681 output when Emacs and other processes write to stderr
2682 simultaneously, so long as the lines are short enough. When a
2683 single diagnostic is emitted via a sequence of calls of one or more
2684 of these functions, the caller should arrange for the last called
2685 function to output a newline at the end. */
2686
2687 void
errputc(int c)2688 errputc (int c)
2689 {
2690 fputc_unlocked (c, errstream ());
2691
2692 #ifdef WINDOWSNT
2693 /* Flush stderr after outputting a newline since stderr is fully
2694 buffered when redirected to a pipe, contrary to POSIX. */
2695 if (c == '\n')
2696 fflush_unlocked (stderr);
2697 #endif
2698 }
2699
2700 void
errwrite(void const * buf,ptrdiff_t nbuf)2701 errwrite (void const *buf, ptrdiff_t nbuf)
2702 {
2703 fwrite_unlocked (buf, 1, nbuf, errstream ());
2704 }
2705
2706 /* Close standard output and standard error, reporting any write
2707 errors as best we can. This is intended for use with atexit. */
2708 void
close_output_streams(void)2709 close_output_streams (void)
2710 {
2711 if (close_stream (stdout) != 0)
2712 {
2713 emacs_perror ("Write error to standard output");
2714 _exit (EXIT_FAILURE);
2715 }
2716
2717 /* Do not close stderr if addresses are being sanitized, as the
2718 sanitizer might report to stderr after this function is invoked. */
2719 bool err = buferr && (fflush (buferr) != 0 || ferror (buferr));
2720 if (err | (ADDRESS_SANITIZER
2721 ? fflush (stderr) != 0 || ferror (stderr)
2722 : close_stream (stderr) != 0))
2723 _exit (EXIT_FAILURE);
2724 }
2725
2726 #ifndef DOS_NT
2727 /* For make-serial-process */
2728 int
serial_open(Lisp_Object port)2729 serial_open (Lisp_Object port)
2730 {
2731 int fd = emacs_open (SSDATA (port), O_RDWR | O_NOCTTY | O_NONBLOCK, 0);
2732 if (fd < 0)
2733 report_file_error ("Opening serial port", port);
2734 #ifdef TIOCEXCL
2735 ioctl (fd, TIOCEXCL, (char *) 0);
2736 #endif
2737
2738 return fd;
2739 }
2740
2741 #if !defined (HAVE_CFMAKERAW)
2742 /* Workaround for targets which are missing cfmakeraw. */
2743 /* Pasted from man page. */
2744 static void
cfmakeraw(struct termios * termios_p)2745 cfmakeraw (struct termios *termios_p)
2746 {
2747 termios_p->c_iflag &= ~(IGNBRK|BRKINT|PARMRK|ISTRIP|INLCR|IGNCR|ICRNL|IXON);
2748 termios_p->c_oflag &= ~OPOST;
2749 termios_p->c_lflag &= ~(ECHO|ECHONL|ICANON|ISIG|IEXTEN);
2750 termios_p->c_cflag &= ~(CSIZE|PARENB);
2751 termios_p->c_cflag |= CS8;
2752 }
2753 #endif /* !defined (HAVE_CFMAKERAW */
2754
2755 #if !defined (HAVE_CFSETSPEED)
2756 /* Workaround for targets which are missing cfsetspeed. */
2757 static int
cfsetspeed(struct termios * termios_p,speed_t vitesse)2758 cfsetspeed (struct termios *termios_p, speed_t vitesse)
2759 {
2760 return (cfsetispeed (termios_p, vitesse)
2761 + cfsetospeed (termios_p, vitesse));
2762 }
2763 #endif
2764
2765 /* The following is based on the glibc implementation of cfsetspeed. */
2766
2767 struct speed_struct
2768 {
2769 speed_t value;
2770 speed_t internal;
2771 };
2772
2773 static const struct speed_struct speeds[] =
2774 {
2775 #ifdef B0
2776 { 0, B0 },
2777 #endif
2778 #ifdef B50
2779 { 50, B50 },
2780 #endif
2781 #ifdef B75
2782 { 75, B75 },
2783 #endif
2784 #ifdef B110
2785 { 110, B110 },
2786 #endif
2787 #ifdef B134
2788 { 134, B134 },
2789 #endif
2790 #ifdef B150
2791 { 150, B150 },
2792 #endif
2793 #ifndef HAVE_TINY_SPEED_T
2794 #ifdef B200
2795 { 200, B200 },
2796 #endif
2797 #ifdef B300
2798 { 300, B300 },
2799 #endif
2800 #ifdef B600
2801 { 600, B600 },
2802 #endif
2803 #ifdef B1200
2804 { 1200, B1200 },
2805 #endif
2806 #ifdef B1200
2807 { 1200, B1200 },
2808 #endif
2809 #ifdef B1800
2810 { 1800, B1800 },
2811 #endif
2812 #ifdef B2400
2813 { 2400, B2400 },
2814 #endif
2815 #ifdef B4800
2816 { 4800, B4800 },
2817 #endif
2818 #ifdef B9600
2819 { 9600, B9600 },
2820 #endif
2821 #ifdef B19200
2822 { 19200, B19200 },
2823 #endif
2824 #ifdef B38400
2825 { 38400, B38400 },
2826 #endif
2827 #ifdef B57600
2828 { 57600, B57600 },
2829 #endif
2830 #ifdef B76800
2831 { 76800, B76800 },
2832 #endif
2833 #ifdef B115200
2834 { 115200, B115200 },
2835 #endif
2836 #ifdef B153600
2837 { 153600, B153600 },
2838 #endif
2839 #ifdef B230400
2840 { 230400, B230400 },
2841 #endif
2842 #ifdef B307200
2843 { 307200, B307200 },
2844 #endif
2845 #ifdef B460800
2846 { 460800, B460800 },
2847 #endif
2848 #ifdef B500000
2849 { 500000, B500000 },
2850 #endif
2851 #ifdef B576000
2852 { 576000, B576000 },
2853 #endif
2854 #ifdef B921600
2855 { 921600, B921600 },
2856 #endif
2857 #ifdef B1000000
2858 { 1000000, B1000000 },
2859 #endif
2860 #ifdef B1152000
2861 { 1152000, B1152000 },
2862 #endif
2863 #ifdef B1500000
2864 { 1500000, B1500000 },
2865 #endif
2866 #ifdef B2000000
2867 { 2000000, B2000000 },
2868 #endif
2869 #ifdef B2500000
2870 { 2500000, B2500000 },
2871 #endif
2872 #ifdef B3000000
2873 { 3000000, B3000000 },
2874 #endif
2875 #ifdef B3500000
2876 { 3500000, B3500000 },
2877 #endif
2878 #ifdef B4000000
2879 { 4000000, B4000000 },
2880 #endif
2881 #endif /* HAVE_TINY_SPEED_T */
2882 };
2883
2884 /* Convert a numerical speed (e.g., 9600) to a Bnnn constant (e.g.,
2885 B9600); see bug#49524. */
2886 static speed_t
convert_speed(speed_t speed)2887 convert_speed (speed_t speed)
2888 {
2889 for (size_t i = 0; i < sizeof speeds / sizeof speeds[0]; i++)
2890 {
2891 if (speed == speeds[i].internal)
2892 return speed;
2893 else if (speed == speeds[i].value)
2894 return speeds[i].internal;
2895 }
2896 return speed;
2897 }
2898
2899 /* For serial-process-configure */
2900 void
serial_configure(struct Lisp_Process * p,Lisp_Object contact)2901 serial_configure (struct Lisp_Process *p,
2902 Lisp_Object contact)
2903 {
2904 Lisp_Object childp2 = Qnil;
2905 Lisp_Object tem = Qnil;
2906 struct termios attr;
2907 int err;
2908 char summary[4] = "???"; /* This usually becomes "8N1". */
2909
2910 childp2 = Fcopy_sequence (p->childp);
2911
2912 /* Read port attributes and prepare default configuration. */
2913 err = tcgetattr (p->outfd, &attr);
2914 if (err != 0)
2915 report_file_error ("Failed tcgetattr", Qnil);
2916 cfmakeraw (&attr);
2917 #if defined (CLOCAL)
2918 attr.c_cflag |= CLOCAL;
2919 #endif
2920 #if defined (CREAD)
2921 attr.c_cflag |= CREAD;
2922 #endif
2923
2924 /* Configure speed. */
2925 if (!NILP (Fplist_member (contact, QCspeed)))
2926 tem = Fplist_get (contact, QCspeed);
2927 else
2928 tem = Fplist_get (p->childp, QCspeed);
2929 CHECK_FIXNUM (tem);
2930 err = cfsetspeed (&attr, convert_speed (XFIXNUM (tem)));
2931 if (err != 0)
2932 report_file_error ("Failed cfsetspeed", tem);
2933 childp2 = Fplist_put (childp2, QCspeed, tem);
2934
2935 /* Configure bytesize. */
2936 if (!NILP (Fplist_member (contact, QCbytesize)))
2937 tem = Fplist_get (contact, QCbytesize);
2938 else
2939 tem = Fplist_get (p->childp, QCbytesize);
2940 if (NILP (tem))
2941 tem = make_fixnum (8);
2942 CHECK_FIXNUM (tem);
2943 if (XFIXNUM (tem) != 7 && XFIXNUM (tem) != 8)
2944 error (":bytesize must be nil (8), 7, or 8");
2945 summary[0] = XFIXNUM (tem) + '0';
2946 #if defined (CSIZE) && defined (CS7) && defined (CS8)
2947 attr.c_cflag &= ~CSIZE;
2948 attr.c_cflag |= ((XFIXNUM (tem) == 7) ? CS7 : CS8);
2949 #else
2950 /* Don't error on bytesize 8, which should be set by cfmakeraw. */
2951 if (XFIXNUM (tem) != 8)
2952 error ("Bytesize cannot be changed");
2953 #endif
2954 childp2 = Fplist_put (childp2, QCbytesize, tem);
2955
2956 /* Configure parity. */
2957 if (!NILP (Fplist_member (contact, QCparity)))
2958 tem = Fplist_get (contact, QCparity);
2959 else
2960 tem = Fplist_get (p->childp, QCparity);
2961 if (!NILP (tem) && !EQ (tem, Qeven) && !EQ (tem, Qodd))
2962 error (":parity must be nil (no parity), `even', or `odd'");
2963 #if defined (PARENB) && defined (PARODD) && defined (IGNPAR) && defined (INPCK)
2964 attr.c_cflag &= ~(PARENB | PARODD);
2965 attr.c_iflag &= ~(IGNPAR | INPCK);
2966 if (NILP (tem))
2967 {
2968 summary[1] = 'N';
2969 }
2970 else if (EQ (tem, Qeven))
2971 {
2972 summary[1] = 'E';
2973 attr.c_cflag |= PARENB;
2974 attr.c_iflag |= (IGNPAR | INPCK);
2975 }
2976 else if (EQ (tem, Qodd))
2977 {
2978 summary[1] = 'O';
2979 attr.c_cflag |= (PARENB | PARODD);
2980 attr.c_iflag |= (IGNPAR | INPCK);
2981 }
2982 #else
2983 /* Don't error on no parity, which should be set by cfmakeraw. */
2984 if (!NILP (tem))
2985 error ("Parity cannot be configured");
2986 #endif
2987 childp2 = Fplist_put (childp2, QCparity, tem);
2988
2989 /* Configure stopbits. */
2990 if (!NILP (Fplist_member (contact, QCstopbits)))
2991 tem = Fplist_get (contact, QCstopbits);
2992 else
2993 tem = Fplist_get (p->childp, QCstopbits);
2994 if (NILP (tem))
2995 tem = make_fixnum (1);
2996 CHECK_FIXNUM (tem);
2997 if (XFIXNUM (tem) != 1 && XFIXNUM (tem) != 2)
2998 error (":stopbits must be nil (1 stopbit), 1, or 2");
2999 summary[2] = XFIXNUM (tem) + '0';
3000 #if defined (CSTOPB)
3001 attr.c_cflag &= ~CSTOPB;
3002 if (XFIXNUM (tem) == 2)
3003 attr.c_cflag |= CSTOPB;
3004 #else
3005 /* Don't error on 1 stopbit, which should be set by cfmakeraw. */
3006 if (XFIXNUM (tem) != 1)
3007 error ("Stopbits cannot be configured");
3008 #endif
3009 childp2 = Fplist_put (childp2, QCstopbits, tem);
3010
3011 /* Configure flowcontrol. */
3012 if (!NILP (Fplist_member (contact, QCflowcontrol)))
3013 tem = Fplist_get (contact, QCflowcontrol);
3014 else
3015 tem = Fplist_get (p->childp, QCflowcontrol);
3016 if (!NILP (tem) && !EQ (tem, Qhw) && !EQ (tem, Qsw))
3017 error (":flowcontrol must be nil (no flowcontrol), `hw', or `sw'");
3018 #if defined (CRTSCTS)
3019 attr.c_cflag &= ~CRTSCTS;
3020 #endif
3021 #if defined (CNEW_RTSCTS)
3022 attr.c_cflag &= ~CNEW_RTSCTS;
3023 #endif
3024 #if defined (IXON) && defined (IXOFF)
3025 attr.c_iflag &= ~(IXON | IXOFF);
3026 #endif
3027 if (NILP (tem))
3028 {
3029 /* Already configured. */
3030 }
3031 else if (EQ (tem, Qhw))
3032 {
3033 #if defined (CRTSCTS)
3034 attr.c_cflag |= CRTSCTS;
3035 #elif defined (CNEW_RTSCTS)
3036 attr.c_cflag |= CNEW_RTSCTS;
3037 #else
3038 error ("Hardware flowcontrol (RTS/CTS) not supported");
3039 #endif
3040 }
3041 else if (EQ (tem, Qsw))
3042 {
3043 #if defined (IXON) && defined (IXOFF)
3044 attr.c_iflag |= (IXON | IXOFF);
3045 #else
3046 error ("Software flowcontrol (XON/XOFF) not supported");
3047 #endif
3048 }
3049 childp2 = Fplist_put (childp2, QCflowcontrol, tem);
3050
3051 /* Activate configuration. */
3052 err = tcsetattr (p->outfd, TCSANOW, &attr);
3053 if (err != 0)
3054 report_file_error ("Failed tcsetattr", Qnil);
3055
3056 childp2 = Fplist_put (childp2, QCsummary, build_string (summary));
3057 pset_childp (p, childp2);
3058 }
3059 #endif /* not DOS_NT */
3060
3061 /* System depended enumeration of and access to system processes a-la ps(1). */
3062
3063 #ifdef HAVE_PROCFS
3064
3065 /* Process enumeration and access via /proc. */
3066
3067 Lisp_Object
list_system_processes(void)3068 list_system_processes (void)
3069 {
3070 Lisp_Object procdir, match, proclist, next;
3071 Lisp_Object tail;
3072
3073 /* For every process on the system, there's a directory in the
3074 "/proc" pseudo-directory whose name is the numeric ID of that
3075 process. */
3076 procdir = build_string ("/proc");
3077 match = build_string ("[0-9]+");
3078 proclist = directory_files_internal (procdir, Qnil, match, Qt,
3079 false, Qnil, Qnil);
3080
3081 /* `proclist' gives process IDs as strings. Destructively convert
3082 each string into a number. */
3083 for (tail = proclist; CONSP (tail); tail = next)
3084 {
3085 next = XCDR (tail);
3086 XSETCAR (tail, Fstring_to_number (XCAR (tail), Qnil));
3087 }
3088
3089 /* directory_files_internal returns the files in reverse order; undo
3090 that. */
3091 proclist = Fnreverse (proclist);
3092 return proclist;
3093 }
3094
3095 #elif defined DARWIN_OS || defined __FreeBSD__ || defined __OpenBSD__
3096
3097 Lisp_Object
list_system_processes(void)3098 list_system_processes (void)
3099 {
3100 #ifdef DARWIN_OS
3101 int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_ALL};
3102 #elif defined __OpenBSD__
3103 int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_ALL, 0,
3104 sizeof (struct kinfo_proc), 4096};
3105 #else
3106 int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_PROC};
3107 #endif
3108 size_t len;
3109 size_t mibsize = sizeof mib / sizeof mib[0];
3110 struct kinfo_proc *procs;
3111 size_t i;
3112
3113 Lisp_Object proclist = Qnil;
3114
3115 if (sysctl (mib, mibsize, NULL, &len, NULL, 0) != 0 || len == 0)
3116 return proclist;
3117
3118 procs = xmalloc (len);
3119 if (sysctl (mib, mibsize, procs, &len, NULL, 0) != 0 || len == 0)
3120 {
3121 xfree (procs);
3122 return proclist;
3123 }
3124
3125 len /= sizeof procs[0];
3126 for (i = 0; i < len; i++)
3127 {
3128 #ifdef DARWIN_OS
3129 proclist = Fcons (INT_TO_INTEGER (procs[i].kp_proc.p_pid), proclist);
3130 #elif defined __OpenBSD__
3131 proclist = Fcons (INT_TO_INTEGER (procs[i].p_pid), proclist);
3132 #else
3133 proclist = Fcons (INT_TO_INTEGER (procs[i].ki_pid), proclist);
3134 #endif
3135 }
3136
3137 xfree (procs);
3138
3139 return proclist;
3140 }
3141
3142 /* The WINDOWSNT implementation is in w32.c.
3143 The MSDOS implementation is in dosfns.c.
3144 The Haiku implementation is in haiku.c. */
3145 #elif !defined (WINDOWSNT) && !defined (MSDOS) && !defined (HAIKU)
3146
3147 Lisp_Object
list_system_processes(void)3148 list_system_processes (void)
3149 {
3150 return Qnil;
3151 }
3152
3153 #endif /* !defined (WINDOWSNT) */
3154
3155
3156 #if defined __FreeBSD__ || defined DARWIN_OS
3157
3158 static struct timespec
timeval_to_timespec(struct timeval t)3159 timeval_to_timespec (struct timeval t)
3160 {
3161 return make_timespec (t.tv_sec, t.tv_usec * 1000);
3162 }
3163 static Lisp_Object
make_lisp_timeval(struct timeval t)3164 make_lisp_timeval (struct timeval t)
3165 {
3166 return make_lisp_time (timeval_to_timespec (t));
3167 }
3168
3169 #elif defined __OpenBSD__
3170
3171 static Lisp_Object
make_lisp_timeval(long sec,long usec)3172 make_lisp_timeval (long sec, long usec)
3173 {
3174 return make_lisp_time(make_timespec(sec, usec * 1000));
3175 }
3176
3177 #endif
3178
3179 #ifdef GNU_LINUX
3180 static struct timespec
time_from_jiffies(unsigned long long tval,long hz)3181 time_from_jiffies (unsigned long long tval, long hz)
3182 {
3183 unsigned long long s = tval / hz;
3184 unsigned long long frac = tval % hz;
3185 int ns;
3186
3187 if (TYPE_MAXIMUM (time_t) < s)
3188 time_overflow ();
3189 if (LONG_MAX - 1 <= ULLONG_MAX / TIMESPEC_HZ
3190 || frac <= ULLONG_MAX / TIMESPEC_HZ)
3191 ns = frac * TIMESPEC_HZ / hz;
3192 else
3193 {
3194 /* This is reachable only in the unlikely case that HZ * HZ
3195 exceeds ULLONG_MAX. It calculates an approximation that is
3196 guaranteed to be in range. */
3197 long hz_per_ns = hz / TIMESPEC_HZ + (hz % TIMESPEC_HZ != 0);
3198 ns = frac / hz_per_ns;
3199 }
3200
3201 return make_timespec (s, ns);
3202 }
3203
3204 static Lisp_Object
ltime_from_jiffies(unsigned long long tval,long hz)3205 ltime_from_jiffies (unsigned long long tval, long hz)
3206 {
3207 struct timespec t = time_from_jiffies (tval, hz);
3208 return make_lisp_time (t);
3209 }
3210
3211 static struct timespec
get_up_time(void)3212 get_up_time (void)
3213 {
3214 FILE *fup;
3215 struct timespec up = make_timespec (0, 0);
3216
3217 block_input ();
3218 fup = emacs_fopen ("/proc/uptime", "r");
3219
3220 if (fup)
3221 {
3222 unsigned long long upsec, upfrac;
3223 int upfrac_start, upfrac_end;
3224
3225 if (fscanf (fup, "%llu.%n%llu%n",
3226 &upsec, &upfrac_start, &upfrac, &upfrac_end)
3227 == 2)
3228 {
3229 if (TYPE_MAXIMUM (time_t) < upsec)
3230 {
3231 upsec = TYPE_MAXIMUM (time_t);
3232 upfrac = TIMESPEC_HZ - 1;
3233 }
3234 else
3235 {
3236 int upfraclen = upfrac_end - upfrac_start;
3237 for (; upfraclen < LOG10_TIMESPEC_HZ; upfraclen++)
3238 upfrac *= 10;
3239 for (; LOG10_TIMESPEC_HZ < upfraclen; upfraclen--)
3240 upfrac /= 10;
3241 upfrac = min (upfrac, TIMESPEC_HZ - 1);
3242 }
3243 up = make_timespec (upsec, upfrac);
3244 }
3245 fclose (fup);
3246 }
3247 unblock_input ();
3248
3249 return up;
3250 }
3251
3252 #define MAJOR(d) (((unsigned)(d) >> 8) & 0xfff)
3253 #define MINOR(d) (((unsigned)(d) & 0xff) | (((unsigned)(d) & 0xfff00000) >> 12))
3254
3255 static Lisp_Object
procfs_ttyname(int rdev)3256 procfs_ttyname (int rdev)
3257 {
3258 FILE *fdev;
3259 char name[PATH_MAX];
3260
3261 block_input ();
3262 fdev = emacs_fopen ("/proc/tty/drivers", "r");
3263 name[0] = 0;
3264
3265 if (fdev)
3266 {
3267 unsigned major;
3268 unsigned long minor_beg, minor_end;
3269 char minor[25]; /* 2 32-bit numbers + dash */
3270 char *endp;
3271
3272 for (; !feof (fdev) && !ferror (fdev); name[0] = 0)
3273 {
3274 if (fscanf (fdev, "%*s %s %u %s %*s\n", name, &major, minor) >= 3
3275 && major == MAJOR (rdev))
3276 {
3277 minor_beg = strtoul (minor, &endp, 0);
3278 if (*endp == '\0')
3279 minor_end = minor_beg;
3280 else if (*endp == '-')
3281 minor_end = strtoul (endp + 1, &endp, 0);
3282 else
3283 continue;
3284
3285 if (MINOR (rdev) >= minor_beg && MINOR (rdev) <= minor_end)
3286 {
3287 sprintf (name + strlen (name), "%u", MINOR (rdev));
3288 break;
3289 }
3290 }
3291 }
3292 fclose (fdev);
3293 }
3294 unblock_input ();
3295 return build_string (name);
3296 }
3297
3298 static uintmax_t
procfs_get_total_memory(void)3299 procfs_get_total_memory (void)
3300 {
3301 FILE *fmem;
3302 uintmax_t retval = 2 * 1024 * 1024; /* default: 2 GiB */
3303 int c;
3304
3305 block_input ();
3306 fmem = emacs_fopen ("/proc/meminfo", "r");
3307
3308 if (fmem)
3309 {
3310 uintmax_t entry_value;
3311 bool done;
3312
3313 do
3314 switch (fscanf (fmem, "MemTotal: %"SCNuMAX, &entry_value))
3315 {
3316 case 1:
3317 retval = entry_value;
3318 done = 1;
3319 break;
3320
3321 case 0:
3322 while ((c = getc (fmem)) != EOF && c != '\n')
3323 continue;
3324 done = c == EOF;
3325 break;
3326
3327 default:
3328 done = 1;
3329 break;
3330 }
3331 while (!done);
3332
3333 fclose (fmem);
3334 }
3335 unblock_input ();
3336 return retval;
3337 }
3338
3339 Lisp_Object
system_process_attributes(Lisp_Object pid)3340 system_process_attributes (Lisp_Object pid)
3341 {
3342 char procfn[PATH_MAX], fn[PATH_MAX];
3343 struct stat st;
3344 struct passwd *pw;
3345 struct group *gr;
3346 long clocks_per_sec;
3347 char *procfn_end;
3348 char procbuf[1025], *p, *q UNINIT;
3349 int fd;
3350 ssize_t nread;
3351 static char const default_cmd[] = "???";
3352 const char *cmd = default_cmd;
3353 int cmdsize = sizeof default_cmd - 1;
3354 char *cmdline = NULL;
3355 ptrdiff_t cmdline_size;
3356 char c;
3357 intmax_t proc_id;
3358 int ppid, pgrp, sess, tty, tpgid, thcount;
3359 uid_t uid;
3360 gid_t gid;
3361 unsigned long long u_time, s_time, cutime, cstime, start;
3362 long priority, niceness, rss;
3363 unsigned long minflt, majflt, cminflt, cmajflt, vsize;
3364 struct timespec tnow, tstart, tboot, telapsed, us_time;
3365 double pcpu, pmem;
3366 Lisp_Object attrs = Qnil;
3367 Lisp_Object decoded_cmd;
3368 ptrdiff_t count;
3369
3370 CHECK_NUMBER (pid);
3371 CONS_TO_INTEGER (pid, pid_t, proc_id);
3372 sprintf (procfn, "/proc/%"PRIdMAX, proc_id);
3373 if (stat (procfn, &st) < 0)
3374 return attrs;
3375
3376 /* euid egid */
3377 uid = st.st_uid;
3378 attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (uid)), attrs);
3379 block_input ();
3380 pw = getpwuid (uid);
3381 unblock_input ();
3382 if (pw)
3383 attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
3384
3385 gid = st.st_gid;
3386 attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (gid)), attrs);
3387 block_input ();
3388 gr = getgrgid (gid);
3389 unblock_input ();
3390 if (gr)
3391 attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
3392
3393 count = SPECPDL_INDEX ();
3394 strcpy (fn, procfn);
3395 procfn_end = fn + strlen (fn);
3396 strcpy (procfn_end, "/stat");
3397 fd = emacs_open (fn, O_RDONLY, 0);
3398 if (fd < 0)
3399 nread = 0;
3400 else
3401 {
3402 record_unwind_protect_int (close_file_unwind, fd);
3403 nread = emacs_read_quit (fd, procbuf, sizeof procbuf - 1);
3404 }
3405 if (0 < nread)
3406 {
3407 procbuf[nread] = '\0';
3408 p = procbuf;
3409
3410 p = strchr (p, '(');
3411 if (p != NULL)
3412 {
3413 q = strrchr (p + 1, ')');
3414 /* comm */
3415 if (q != NULL)
3416 {
3417 cmd = p + 1;
3418 cmdsize = q - cmd;
3419 }
3420 }
3421 else
3422 q = NULL;
3423 /* Command name is encoded in locale-coding-system; decode it. */
3424 AUTO_STRING_WITH_LEN (cmd_str, cmd, cmdsize);
3425 decoded_cmd = code_convert_string_norecord (cmd_str,
3426 Vlocale_coding_system, 0);
3427 attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
3428
3429 /* state ppid pgrp sess tty tpgid . minflt cminflt majflt cmajflt
3430 utime stime cutime cstime priority nice thcount . start vsize rss */
3431 if (q
3432 && (sscanf (q + 2, ("%c %d %d %d %d %d %*u %lu %lu %lu %lu "
3433 "%Lu %Lu %Lu %Lu %ld %ld %d %*d %Lu %lu %ld"),
3434 &c, &ppid, &pgrp, &sess, &tty, &tpgid,
3435 &minflt, &cminflt, &majflt, &cmajflt,
3436 &u_time, &s_time, &cutime, &cstime,
3437 &priority, &niceness, &thcount, &start, &vsize, &rss)
3438 == 20))
3439 {
3440 char state_str[2];
3441 state_str[0] = c;
3442 state_str[1] = '\0';
3443 attrs = Fcons (Fcons (Qstate, build_string (state_str)), attrs);
3444 attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (ppid)), attrs);
3445 attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (pgrp)), attrs);
3446 attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (sess)), attrs);
3447 attrs = Fcons (Fcons (Qttname, procfs_ttyname (tty)), attrs);
3448 attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (tpgid)), attrs);
3449 attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (minflt)), attrs);
3450 attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (majflt)), attrs);
3451 attrs = Fcons (Fcons (Qcminflt, INT_TO_INTEGER (cminflt)), attrs);
3452 attrs = Fcons (Fcons (Qcmajflt, INT_TO_INTEGER (cmajflt)), attrs);
3453 clocks_per_sec = sysconf (_SC_CLK_TCK);
3454 if (clocks_per_sec < 0)
3455 clocks_per_sec = 100;
3456 attrs = Fcons (Fcons (Qutime,
3457 ltime_from_jiffies (u_time, clocks_per_sec)),
3458 attrs);
3459 attrs = Fcons (Fcons (Qstime,
3460 ltime_from_jiffies (s_time, clocks_per_sec)),
3461 attrs);
3462 attrs = Fcons (Fcons (Qtime,
3463 ltime_from_jiffies (s_time + u_time,
3464 clocks_per_sec)),
3465 attrs);
3466 attrs = Fcons (Fcons (Qcutime,
3467 ltime_from_jiffies (cutime, clocks_per_sec)),
3468 attrs);
3469 attrs = Fcons (Fcons (Qcstime,
3470 ltime_from_jiffies (cstime, clocks_per_sec)),
3471 attrs);
3472 attrs = Fcons (Fcons (Qctime,
3473 ltime_from_jiffies (cstime + cutime,
3474 clocks_per_sec)),
3475 attrs);
3476 attrs = Fcons (Fcons (Qpri, make_fixnum (priority)), attrs);
3477 attrs = Fcons (Fcons (Qnice, make_fixnum (niceness)), attrs);
3478 attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (thcount)), attrs);
3479 tnow = current_timespec ();
3480 telapsed = get_up_time ();
3481 tboot = timespec_sub (tnow, telapsed);
3482 tstart = time_from_jiffies (start, clocks_per_sec);
3483 tstart = timespec_add (tboot, tstart);
3484 attrs = Fcons (Fcons (Qstart, make_lisp_time (tstart)), attrs);
3485 attrs = Fcons (Fcons (Qvsize, INT_TO_INTEGER (vsize / 1024)), attrs);
3486 attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (4 * rss)), attrs);
3487 telapsed = timespec_sub (tnow, tstart);
3488 attrs = Fcons (Fcons (Qetime, make_lisp_time (telapsed)), attrs);
3489 us_time = time_from_jiffies (u_time + s_time, clocks_per_sec);
3490 pcpu = timespectod (us_time) / timespectod (telapsed);
3491 if (pcpu > 1.0)
3492 pcpu = 1.0;
3493 attrs = Fcons (Fcons (Qpcpu, make_float (100 * pcpu)), attrs);
3494 pmem = 4.0 * 100 * rss / procfs_get_total_memory ();
3495 if (pmem > 100)
3496 pmem = 100;
3497 attrs = Fcons (Fcons (Qpmem, make_float (pmem)), attrs);
3498 }
3499 }
3500 unbind_to (count, Qnil);
3501
3502 /* args */
3503 strcpy (procfn_end, "/cmdline");
3504 fd = emacs_open (fn, O_RDONLY, 0);
3505 if (fd >= 0)
3506 {
3507 ptrdiff_t readsize, nread_incr;
3508 record_unwind_protect_int (close_file_unwind, fd);
3509 record_unwind_protect_nothing ();
3510 nread = cmdline_size = 0;
3511
3512 do
3513 {
3514 cmdline = xpalloc (cmdline, &cmdline_size, 2, STRING_BYTES_BOUND, 1);
3515 set_unwind_protect_ptr (count + 1, xfree, cmdline);
3516
3517 /* Leave room even if every byte needs escaping below. */
3518 readsize = (cmdline_size >> 1) - nread;
3519
3520 nread_incr = emacs_read_quit (fd, cmdline + nread, readsize);
3521 nread += max (0, nread_incr);
3522 }
3523 while (nread_incr == readsize);
3524
3525 if (nread)
3526 {
3527 /* We don't want trailing null characters. */
3528 for (p = cmdline + nread; cmdline < p && !p[-1]; p--)
3529 continue;
3530
3531 /* Escape-quote whitespace and backslashes. */
3532 q = cmdline + cmdline_size;
3533 while (cmdline < p)
3534 {
3535 char c = *--p;
3536 *--q = c ? c : ' ';
3537 if (c_isspace (c) || c == '\\')
3538 *--q = '\\';
3539 }
3540
3541 nread = cmdline + cmdline_size - q;
3542 }
3543
3544 if (!nread)
3545 {
3546 nread = cmdsize + 2;
3547 cmdline_size = nread + 1;
3548 q = cmdline = xrealloc (cmdline, cmdline_size);
3549 set_unwind_protect_ptr (count + 1, xfree, cmdline);
3550 sprintf (cmdline, "[%.*s]", cmdsize, cmd);
3551 }
3552 /* Command line is encoded in locale-coding-system; decode it. */
3553 AUTO_STRING_WITH_LEN (cmd_str, q, nread);
3554 decoded_cmd = code_convert_string_norecord (cmd_str,
3555 Vlocale_coding_system, 0);
3556 unbind_to (count, Qnil);
3557 attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
3558 }
3559
3560 return attrs;
3561 }
3562
3563 #elif defined (SOLARIS2) && defined (HAVE_PROCFS)
3564
3565 /* The <procfs.h> header does not like to be included if _LP64 is defined and
3566 __FILE_OFFSET_BITS == 64. This is an ugly workaround that. */
3567 #if !defined (_LP64) && defined (_FILE_OFFSET_BITS) && (_FILE_OFFSET_BITS == 64)
3568 #define PROCFS_FILE_OFFSET_BITS_HACK 1
3569 #undef _FILE_OFFSET_BITS
3570 #else
3571 #define PROCFS_FILE_OFFSET_BITS_HACK 0
3572 #endif
3573
3574 #include <procfs.h>
3575
3576 #if PROCFS_FILE_OFFSET_BITS_HACK == 1
3577 #define _FILE_OFFSET_BITS 64
3578 #ifdef _FILE_OFFSET_BITS /* Avoid unused-macro warnings. */
3579 #endif
3580 #endif /* PROCFS_FILE_OFFSET_BITS_HACK == 1 */
3581
3582 Lisp_Object
system_process_attributes(Lisp_Object pid)3583 system_process_attributes (Lisp_Object pid)
3584 {
3585 char procfn[PATH_MAX], fn[PATH_MAX];
3586 struct stat st;
3587 struct passwd *pw;
3588 struct group *gr;
3589 char *procfn_end;
3590 struct psinfo pinfo;
3591 int fd;
3592 ssize_t nread;
3593 intmax_t proc_id;
3594 uid_t uid;
3595 gid_t gid;
3596 Lisp_Object attrs = Qnil;
3597 Lisp_Object decoded_cmd;
3598 ptrdiff_t count;
3599
3600 CHECK_NUMBER (pid);
3601 CONS_TO_INTEGER (pid, pid_t, proc_id);
3602 sprintf (procfn, "/proc/%"PRIdMAX, proc_id);
3603 if (stat (procfn, &st) < 0)
3604 return attrs;
3605
3606 /* euid egid */
3607 uid = st.st_uid;
3608 attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (uid)), attrs);
3609 block_input ();
3610 pw = getpwuid (uid);
3611 unblock_input ();
3612 if (pw)
3613 attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
3614
3615 gid = st.st_gid;
3616 attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (gid)), attrs);
3617 block_input ();
3618 gr = getgrgid (gid);
3619 unblock_input ();
3620 if (gr)
3621 attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
3622
3623 count = SPECPDL_INDEX ();
3624 strcpy (fn, procfn);
3625 procfn_end = fn + strlen (fn);
3626 strcpy (procfn_end, "/psinfo");
3627 fd = emacs_open (fn, O_RDONLY, 0);
3628 if (fd < 0)
3629 nread = 0;
3630 else
3631 {
3632 record_unwind_protect_int (close_file_unwind, fd);
3633 nread = emacs_read_quit (fd, &pinfo, sizeof pinfo);
3634 }
3635
3636 if (nread == sizeof pinfo)
3637 {
3638 attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (pinfo.pr_ppid)), attrs);
3639 attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (pinfo.pr_pgid)), attrs);
3640 attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (pinfo.pr_sid)), attrs);
3641
3642 {
3643 char state_str[2];
3644 state_str[0] = pinfo.pr_lwp.pr_sname;
3645 state_str[1] = '\0';
3646 attrs = Fcons (Fcons (Qstate, build_string (state_str)), attrs);
3647 }
3648
3649 /* FIXME: missing Qttyname. psinfo.pr_ttydev is a dev_t,
3650 need to get a string from it. */
3651
3652 /* FIXME: missing: Qtpgid */
3653
3654 /* FIXME: missing:
3655 Qminflt
3656 Qmajflt
3657 Qcminflt
3658 Qcmajflt
3659
3660 Qutime
3661 Qcutime
3662 Qstime
3663 Qcstime
3664 Are they available? */
3665
3666 attrs = Fcons (Fcons (Qtime, make_lisp_time (pinfo.pr_time)), attrs);
3667 attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs);
3668 attrs = Fcons (Fcons (Qpri, make_fixnum (pinfo.pr_lwp.pr_pri)), attrs);
3669 attrs = Fcons (Fcons (Qnice, make_fixnum (pinfo.pr_lwp.pr_nice)), attrs);
3670 attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (pinfo.pr_nlwp)), attrs);
3671
3672 attrs = Fcons (Fcons (Qstart, make_lisp_time (pinfo.pr_start)), attrs);
3673 attrs = Fcons (Fcons (Qvsize, INT_TO_INTEGER (pinfo.pr_size)), attrs);
3674 attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (pinfo.pr_rssize)), attrs);
3675
3676 /* pr_pctcpu and pr_pctmem are unsigned integers in the
3677 range 0 .. 2**15, representing 0.0 .. 1.0. */
3678 attrs = Fcons (Fcons (Qpcpu,
3679 make_float (100.0 / 0x8000 * pinfo.pr_pctcpu)),
3680 attrs);
3681 attrs = Fcons (Fcons (Qpmem,
3682 make_float (100.0 / 0x8000 * pinfo.pr_pctmem)),
3683 attrs);
3684
3685 AUTO_STRING (fname, pinfo.pr_fname);
3686 decoded_cmd = code_convert_string_norecord (fname,
3687 Vlocale_coding_system, 0);
3688 attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
3689 AUTO_STRING (psargs, pinfo.pr_psargs);
3690 decoded_cmd = code_convert_string_norecord (psargs,
3691 Vlocale_coding_system, 0);
3692 attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
3693 }
3694 return unbind_to (count, attrs);
3695 }
3696
3697 #elif defined __FreeBSD__
3698
3699 Lisp_Object
system_process_attributes(Lisp_Object pid)3700 system_process_attributes (Lisp_Object pid)
3701 {
3702 int proc_id;
3703 int pagesize = getpagesize ();
3704 unsigned long npages;
3705 int fscale;
3706 struct passwd *pw;
3707 struct group *gr;
3708 char *ttyname;
3709 size_t len;
3710 char args[MAXPATHLEN];
3711 struct timespec t, now;
3712
3713 int mib[4] = {CTL_KERN, KERN_PROC, KERN_PROC_PID};
3714 struct kinfo_proc proc;
3715 size_t proclen = sizeof proc;
3716
3717 Lisp_Object attrs = Qnil;
3718 Lisp_Object decoded_comm;
3719
3720 CHECK_NUMBER (pid);
3721 CONS_TO_INTEGER (pid, int, proc_id);
3722 mib[3] = proc_id;
3723
3724 if (sysctl (mib, 4, &proc, &proclen, NULL, 0) != 0 || proclen == 0)
3725 return attrs;
3726
3727 attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (proc.ki_uid)), attrs);
3728
3729 block_input ();
3730 pw = getpwuid (proc.ki_uid);
3731 unblock_input ();
3732 if (pw)
3733 attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
3734
3735 attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (proc.ki_svgid)), attrs);
3736
3737 block_input ();
3738 gr = getgrgid (proc.ki_svgid);
3739 unblock_input ();
3740 if (gr)
3741 attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
3742
3743 AUTO_STRING (comm, proc.ki_comm);
3744 decoded_comm = code_convert_string_norecord (comm, Vlocale_coding_system, 0);
3745
3746 attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
3747 {
3748 char state[2] = {'\0', '\0'};
3749 switch (proc.ki_stat)
3750 {
3751 case SRUN:
3752 state[0] = 'R';
3753 break;
3754
3755 case SSLEEP:
3756 state[0] = 'S';
3757 break;
3758
3759 case SLOCK:
3760 state[0] = 'D';
3761 break;
3762
3763 case SZOMB:
3764 state[0] = 'Z';
3765 break;
3766
3767 case SSTOP:
3768 state[0] = 'T';
3769 break;
3770 }
3771 attrs = Fcons (Fcons (Qstate, build_string (state)), attrs);
3772 }
3773
3774 attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (proc.ki_ppid)), attrs);
3775 attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (proc.ki_pgid)), attrs);
3776 attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (proc.ki_sid)), attrs);
3777
3778 block_input ();
3779 ttyname = proc.ki_tdev == NODEV ? NULL : devname (proc.ki_tdev, S_IFCHR);
3780 unblock_input ();
3781 if (ttyname)
3782 attrs = Fcons (Fcons (Qttname, build_string (ttyname)), attrs);
3783
3784 attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.ki_tpgid)), attrs);
3785 attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (proc.ki_rusage.ru_minflt)),
3786 attrs);
3787 attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (proc.ki_rusage.ru_majflt)),
3788 attrs);
3789 attrs = Fcons (Fcons (Qcminflt, make_fixnum (proc.ki_rusage_ch.ru_minflt)), attrs);
3790 attrs = Fcons (Fcons (Qcmajflt, make_fixnum (proc.ki_rusage_ch.ru_majflt)), attrs);
3791
3792 attrs = Fcons (Fcons (Qutime, make_lisp_timeval (proc.ki_rusage.ru_utime)),
3793 attrs);
3794 attrs = Fcons (Fcons (Qstime, make_lisp_timeval (proc.ki_rusage.ru_stime)),
3795 attrs);
3796 t = timespec_add (timeval_to_timespec (proc.ki_rusage.ru_utime),
3797 timeval_to_timespec (proc.ki_rusage.ru_stime));
3798 attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs);
3799
3800 attrs = Fcons (Fcons (Qcutime,
3801 make_lisp_timeval (proc.ki_rusage_ch.ru_utime)),
3802 attrs);
3803 attrs = Fcons (Fcons (Qcstime,
3804 make_lisp_timeval (proc.ki_rusage_ch.ru_utime)),
3805 attrs);
3806 t = timespec_add (timeval_to_timespec (proc.ki_rusage_ch.ru_utime),
3807 timeval_to_timespec (proc.ki_rusage_ch.ru_stime));
3808 attrs = Fcons (Fcons (Qctime, make_lisp_time (t)), attrs);
3809
3810 attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (proc.ki_numthreads)), attrs);
3811 attrs = Fcons (Fcons (Qpri, make_fixnum (proc.ki_pri.pri_native)), attrs);
3812 attrs = Fcons (Fcons (Qnice, make_fixnum (proc.ki_nice)), attrs);
3813 attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.ki_start)), attrs);
3814 attrs = Fcons (Fcons (Qvsize, make_fixnum (proc.ki_size >> 10)), attrs);
3815 attrs = Fcons (Fcons (Qrss, make_fixnum (proc.ki_rssize * pagesize >> 10)),
3816 attrs);
3817
3818 now = current_timespec ();
3819 t = timespec_sub (now, timeval_to_timespec (proc.ki_start));
3820 attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs);
3821
3822 len = sizeof fscale;
3823 if (sysctlbyname ("kern.fscale", &fscale, &len, NULL, 0) == 0)
3824 {
3825 double pcpu;
3826 fixpt_t ccpu;
3827 len = sizeof ccpu;
3828 if (sysctlbyname ("kern.ccpu", &ccpu, &len, NULL, 0) == 0)
3829 {
3830 pcpu = (100.0 * proc.ki_pctcpu / fscale
3831 / (1 - exp (proc.ki_swtime * log ((double) ccpu / fscale))));
3832 attrs = Fcons (Fcons (Qpcpu, INT_TO_INTEGER (pcpu)), attrs);
3833 }
3834 }
3835
3836 len = sizeof npages;
3837 if (sysctlbyname ("hw.availpages", &npages, &len, NULL, 0) == 0)
3838 {
3839 double pmem = (proc.ki_flag & P_INMEM
3840 ? 100.0 * proc.ki_rssize / npages
3841 : 0);
3842 attrs = Fcons (Fcons (Qpmem, INT_TO_INTEGER (pmem)), attrs);
3843 }
3844
3845 mib[2] = KERN_PROC_ARGS;
3846 len = MAXPATHLEN;
3847 if (sysctl (mib, 4, args, &len, NULL, 0) == 0 && len != 0)
3848 {
3849 int i;
3850 for (i = 0; i < len; i++)
3851 {
3852 if (! args[i] && i < len - 1)
3853 args[i] = ' ';
3854 }
3855
3856 AUTO_STRING (comm, args);
3857 decoded_comm = code_convert_string_norecord (comm,
3858 Vlocale_coding_system, 0);
3859
3860 attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
3861 }
3862
3863 return attrs;
3864 }
3865
3866 #elif defined __OpenBSD__
3867
3868 Lisp_Object
system_process_attributes(Lisp_Object pid)3869 system_process_attributes (Lisp_Object pid)
3870 {
3871 int proc_id, nentries, fscale, i;
3872 int pagesize = getpagesize ();
3873 int mib[6];
3874 size_t len;
3875 double pct;
3876 char *ttyname, args[ARG_MAX];
3877 struct kinfo_proc proc;
3878 struct passwd *pw;
3879 struct group *gr;
3880 struct timespec t;
3881 struct uvmexp uvmexp;
3882
3883 Lisp_Object attrs = Qnil;
3884 Lisp_Object decoded_comm;
3885
3886 CHECK_NUMBER (pid);
3887 CONS_TO_INTEGER (pid, int, proc_id);
3888
3889 len = sizeof proc;
3890 mib[0] = CTL_KERN;
3891 mib[1] = KERN_PROC;
3892 mib[2] = KERN_PROC_PID;
3893 mib[3] = proc_id;
3894 mib[4] = len;
3895 mib[5] = 1;
3896 if (sysctl (mib, 6, &proc, &len, NULL, 0) != 0)
3897 return attrs;
3898
3899 attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (proc.p_uid)), attrs);
3900
3901 block_input ();
3902 pw = getpwuid (proc.p_uid);
3903 unblock_input ();
3904 if (pw)
3905 attrs = Fcons (Fcons (Quser, build_string(pw->pw_name)), attrs);
3906
3907 attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER(proc.p_svgid)), attrs);
3908
3909 block_input ();
3910 gr = getgrgid (proc.p_svgid);
3911 unblock_input ();
3912 if (gr)
3913 attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
3914
3915 AUTO_STRING (comm, proc.p_comm);
3916 decoded_comm = code_convert_string_norecord (comm, Vlocale_coding_system, 0);
3917 attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
3918
3919 {
3920 char state[2] = {'\0', '\0'};
3921 switch (proc.p_stat) {
3922 case SIDL:
3923 state[0] = 'I';
3924 break;
3925 case SRUN:
3926 state[0] = 'R';
3927 break;
3928 case SSLEEP:
3929 state[0] = 'S';
3930 break;
3931 case SSTOP:
3932 state[0] = 'T';
3933 break;
3934 case SZOMB:
3935 state[0] = 'Z';
3936 break;
3937 case SDEAD:
3938 state[0] = 'D';
3939 break;
3940 }
3941 attrs = Fcons (Fcons (Qstate, build_string (state)), attrs);
3942 }
3943
3944 attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (proc.p_ppid)), attrs);
3945 attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (proc.p_gid)), attrs);
3946 attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (proc.p_sid)), attrs);
3947
3948 block_input ();
3949 ttyname = proc.p_tdev == NODEV ? NULL : devname (proc.p_tdev, S_IFCHR);
3950 unblock_input ();
3951 if (ttyname)
3952 attrs = Fcons (Fcons (Qttname, build_string (ttyname)), attrs);
3953
3954 attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.p_tpgid)), attrs);
3955 attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (proc.p_uru_minflt)),
3956 attrs);
3957 attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (proc.p_uru_majflt)),
3958 attrs);
3959
3960 /* FIXME: missing cminflt, cmajflt. */
3961
3962 attrs = Fcons (Fcons (Qutime, make_lisp_timeval (proc.p_uutime_sec,
3963 proc.p_uutime_usec)),
3964 attrs);
3965 attrs = Fcons (Fcons (Qstime, make_lisp_timeval (proc.p_ustime_sec,
3966 proc.p_ustime_usec)),
3967 attrs);
3968 t = timespec_add (make_timespec (proc.p_uutime_sec,
3969 proc.p_uutime_usec * 1000),
3970 make_timespec (proc.p_ustime_sec,
3971 proc.p_ustime_usec * 1000));
3972 attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs);
3973
3974 attrs = Fcons (Fcons (Qcutime, make_lisp_timeval (proc.p_uctime_sec,
3975 proc.p_uctime_usec)),
3976 attrs);
3977
3978 /* FIXME: missing cstime and thus ctime. */
3979
3980 attrs = Fcons (Fcons (Qpri, make_fixnum (proc.p_priority)), attrs);
3981 attrs = Fcons (Fcons (Qnice, make_fixnum (proc.p_nice)), attrs);
3982
3983 /* FIXME: missing thcount (thread count) */
3984
3985 attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.p_ustart_sec,
3986 proc.p_ustart_usec)),
3987 attrs);
3988
3989 len = (proc.p_vm_tsize + proc.p_vm_dsize + proc.p_vm_ssize) * pagesize >> 10;
3990 attrs = Fcons (Fcons (Qvsize, make_fixnum (len)), attrs);
3991
3992 attrs = Fcons (Fcons (Qrss, make_fixnum (proc.p_vm_rssize * pagesize >> 10)),
3993 attrs);
3994
3995 t = make_timespec (proc.p_ustart_sec,
3996 proc.p_ustart_usec * 1000);
3997 t = timespec_sub (current_timespec (), t);
3998 attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs);
3999
4000 len = sizeof (fscale);
4001 mib[0] = CTL_KERN;
4002 mib[1] = KERN_FSCALE;
4003 if (sysctl (mib, 2, &fscale, &len, NULL, 0) != -1)
4004 {
4005 pct = (double)proc.p_pctcpu / fscale * 100.0;
4006 attrs = Fcons (Fcons (Qpcpu, make_float (pct)), attrs);
4007 }
4008
4009 len = sizeof (uvmexp);
4010 mib[0] = CTL_VM;
4011 mib[1] = VM_UVMEXP;
4012 if (sysctl (mib, 2, &uvmexp, &len, NULL, 0) != -1)
4013 {
4014 pct = (100.0 * (double)proc.p_vm_rssize / uvmexp.npages);
4015 attrs = Fcons (Fcons (Qpmem, make_float (pct)), attrs);
4016 }
4017
4018 len = sizeof args;
4019 mib[0] = CTL_KERN;
4020 mib[1] = KERN_PROC_ARGS;
4021 mib[2] = proc_id;
4022 mib[3] = KERN_PROC_ARGV;
4023 if (sysctl (mib, 4, &args, &len, NULL, 0) == 0 && len != 0)
4024 {
4025 char **argv = (char**)args;
4026
4027 /* concatenate argv reusing the existing storage storage.
4028 sysctl(8) guarantees that "the buffer pointed to by oldp is
4029 filled with an array of char pointers followed by the strings
4030 themselves." */
4031 for (i = 0; argv[i] != NULL; ++i)
4032 {
4033 if (argv[i+1] != NULL)
4034 {
4035 len = strlen (argv[i]);
4036 argv[i][len] = ' ';
4037 }
4038 }
4039
4040 AUTO_STRING (comm, *argv);
4041 decoded_comm = code_convert_string_norecord (comm,
4042 Vlocale_coding_system, 0);
4043 attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
4044 }
4045
4046 return attrs;
4047 }
4048
4049 #elif defined DARWIN_OS
4050
4051 Lisp_Object
system_process_attributes(Lisp_Object pid)4052 system_process_attributes (Lisp_Object pid)
4053 {
4054 int proc_id, i;
4055 struct passwd *pw;
4056 struct group *gr;
4057 char *ttyname;
4058 struct timeval starttime;
4059 struct timespec t, now;
4060 dev_t tdev;
4061 uid_t uid;
4062 gid_t gid;
4063
4064 int mib[4] = {CTL_KERN, KERN_PROC, KERN_PROC_PID};
4065 struct kinfo_proc proc;
4066 size_t len = sizeof proc;
4067
4068 Lisp_Object attrs = Qnil;
4069 Lisp_Object decoded_comm;
4070
4071 CHECK_NUMBER (pid);
4072 CONS_TO_INTEGER (pid, int, proc_id);
4073 mib[3] = proc_id;
4074
4075 if (sysctl (mib, 4, &proc, &len, NULL, 0) != 0 || len == 0)
4076 return attrs;
4077
4078 uid = proc.kp_eproc.e_ucred.cr_uid;
4079 attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (uid)), attrs);
4080
4081 block_input ();
4082 pw = getpwuid (uid);
4083 unblock_input ();
4084 if (pw)
4085 attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
4086
4087 gid = proc.kp_eproc.e_pcred.p_svgid;
4088 attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (gid)), attrs);
4089
4090 block_input ();
4091 gr = getgrgid (gid);
4092 unblock_input ();
4093 if (gr)
4094 attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
4095
4096 char pathbuf[PROC_PIDPATHINFO_MAXSIZE];
4097 char *comm;
4098
4099 if (proc_pidpath (proc_id, pathbuf, sizeof(pathbuf)) > 0)
4100 {
4101 if ((comm = strrchr (pathbuf, '/')))
4102 comm++;
4103 else
4104 comm = pathbuf;
4105 }
4106 else
4107 comm = proc.kp_proc.p_comm;
4108
4109 decoded_comm = (code_convert_string_norecord
4110 (build_unibyte_string (comm),
4111 Vlocale_coding_system, 0));
4112 attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
4113
4114 {
4115 char state[2] = {'\0', '\0'};
4116 switch (proc.kp_proc.p_stat)
4117 {
4118 case SRUN:
4119 state[0] = 'R';
4120 break;
4121
4122 case SSLEEP:
4123 state[0] = 'S';
4124 break;
4125
4126 case SZOMB:
4127 state[0] = 'Z';
4128 break;
4129
4130 case SSTOP:
4131 state[0] = 'T';
4132 break;
4133
4134 case SIDL:
4135 state[0] = 'I';
4136 break;
4137 }
4138 attrs = Fcons (Fcons (Qstate, build_string (state)), attrs);
4139 }
4140
4141 attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (proc.kp_eproc.e_ppid)), attrs);
4142 attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (proc.kp_eproc.e_pgid)), attrs);
4143
4144 tdev = proc.kp_eproc.e_tdev;
4145 block_input ();
4146 ttyname = tdev == NODEV ? NULL : devname (tdev, S_IFCHR);
4147 unblock_input ();
4148 if (ttyname)
4149 attrs = Fcons (Fcons (Qttname, build_string (ttyname)), attrs);
4150
4151 attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.kp_eproc.e_tpgid)),
4152 attrs);
4153
4154 rusage_info_current ri;
4155 if (proc_pid_rusage(proc_id, RUSAGE_INFO_CURRENT, (rusage_info_t *) &ri) == 0)
4156 {
4157 struct timespec utime = make_timespec (ri.ri_user_time / TIMESPEC_HZ,
4158 ri.ri_user_time % TIMESPEC_HZ);
4159 struct timespec stime = make_timespec (ri.ri_system_time / TIMESPEC_HZ,
4160 ri.ri_system_time % TIMESPEC_HZ);
4161 attrs = Fcons (Fcons (Qutime, make_lisp_time (utime)), attrs);
4162 attrs = Fcons (Fcons (Qstime, make_lisp_time (stime)), attrs);
4163 attrs = Fcons (Fcons (Qtime, make_lisp_time (timespec_add (utime, stime))), attrs);
4164
4165 attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (ri.ri_pageins)), attrs);
4166 }
4167
4168 starttime = proc.kp_proc.p_starttime;
4169 attrs = Fcons (Fcons (Qnice, make_fixnum (proc.kp_proc.p_nice)), attrs);
4170 attrs = Fcons (Fcons (Qstart, make_lisp_timeval (starttime)), attrs);
4171
4172 now = current_timespec ();
4173 t = timespec_sub (now, timeval_to_timespec (starttime));
4174 attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs);
4175
4176 struct proc_taskinfo taskinfo;
4177 if (proc_pidinfo (proc_id, PROC_PIDTASKINFO, 0, &taskinfo, sizeof (taskinfo)) > 0)
4178 {
4179 attrs = Fcons (Fcons (Qvsize, make_fixnum (taskinfo.pti_virtual_size / 1024)), attrs);
4180 attrs = Fcons (Fcons (Qrss, make_fixnum (taskinfo.pti_resident_size / 1024)), attrs);
4181 attrs = Fcons (Fcons (Qthcount, make_fixnum (taskinfo.pti_threadnum)), attrs);
4182 }
4183
4184 #ifdef KERN_PROCARGS2
4185 char args[ARG_MAX];
4186 mib[1] = KERN_PROCARGS2;
4187 mib[2] = proc_id;
4188 len = sizeof args;
4189
4190 if (sysctl (mib, 3, &args, &len, NULL, 0) == 0 && len != 0)
4191 {
4192 char *start, *end;
4193
4194 int argc = *(int*)args; /* argc is the first int */
4195 start = args + sizeof (int);
4196
4197 start += strlen (start) + 1; /* skip executable name and any '\0's */
4198 while ((start - args < len) && ! *start) start++;
4199
4200 /* skip argv to find real end */
4201 for (i = 0, end = start; i < argc && (end - args) < len; i++)
4202 {
4203 end += strlen (end) + 1;
4204 }
4205
4206 len = end - start;
4207 for (int i = 0; i < len; i++)
4208 {
4209 if (! start[i] && i < len - 1)
4210 start[i] = ' ';
4211 }
4212
4213 AUTO_STRING (comm, start);
4214 decoded_comm = code_convert_string_norecord (comm,
4215 Vlocale_coding_system, 0);
4216 attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
4217 }
4218 #endif /* KERN_PROCARGS2 */
4219
4220 return attrs;
4221 }
4222
4223 /* The WINDOWSNT implementation is in w32.c.
4224 The MSDOS implementation is in dosfns.c.
4225 The HAIKU implementation is in haiku.c. */
4226 #elif !defined (WINDOWSNT) && !defined (MSDOS) && !defined (HAIKU)
4227
4228 Lisp_Object
system_process_attributes(Lisp_Object pid)4229 system_process_attributes (Lisp_Object pid)
4230 {
4231 return Qnil;
4232 }
4233
4234 #endif /* !defined (WINDOWSNT) */
4235
4236 DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
4237 0, 0, 0,
4238 doc: /* Return the current run time used by Emacs.
4239 The time is returned as in the style of `current-time'.
4240
4241 On systems that can't determine the run time, `get-internal-run-time'
4242 does the same thing as `current-time'. */)
4243 (void)
4244 {
4245 #ifdef HAVE_GETRUSAGE
4246 struct rusage usage;
4247 time_t secs;
4248 int usecs;
4249
4250 if (getrusage (RUSAGE_SELF, &usage) < 0)
4251 /* This shouldn't happen. What action is appropriate? */
4252 xsignal0 (Qerror);
4253
4254 /* Sum up user time and system time. */
4255 secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec;
4256 usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec;
4257 if (usecs >= 1000000)
4258 {
4259 usecs -= 1000000;
4260 secs++;
4261 }
4262 return make_lisp_time (make_timespec (secs, usecs * 1000));
4263 #else /* ! HAVE_GETRUSAGE */
4264 #ifdef WINDOWSNT
4265 return w32_get_internal_run_time ();
4266 #else /* ! WINDOWSNT */
4267 return Fcurrent_time ();
4268 #endif /* WINDOWSNT */
4269 #endif /* HAVE_GETRUSAGE */
4270 }
4271
4272 /* Wide character string collation. */
4273
4274 #ifdef __STDC_ISO_10646__
4275 # include <wchar.h>
4276 # include <wctype.h>
4277
4278 # if defined HAVE_NEWLOCALE || defined HAVE_SETLOCALE
4279 # include <locale.h>
4280 # endif
4281 # ifndef LC_COLLATE
4282 # define LC_COLLATE 0
4283 # endif
4284 # ifndef LC_COLLATE_MASK
4285 # define LC_COLLATE_MASK 0
4286 # endif
4287 # ifndef LC_CTYPE
4288 # define LC_CTYPE 0
4289 # endif
4290 # ifndef LC_CTYPE_MASK
4291 # define LC_CTYPE_MASK 0
4292 # endif
4293
4294 # ifndef HAVE_NEWLOCALE
4295 # undef freelocale
4296 # undef locale_t
4297 # undef newlocale
4298 # undef wcscoll_l
4299 # undef towlower_l
4300 # define freelocale emacs_freelocale
4301 # define locale_t emacs_locale_t
4302 # define newlocale emacs_newlocale
4303 # define wcscoll_l emacs_wcscoll_l
4304 # define towlower_l emacs_towlower_l
4305
4306 typedef char const *locale_t;
4307
4308 static locale_t
newlocale(int category_mask,char const * locale,locale_t loc)4309 newlocale (int category_mask, char const *locale, locale_t loc)
4310 {
4311 return locale;
4312 }
4313
4314 static void
freelocale(locale_t loc)4315 freelocale (locale_t loc)
4316 {
4317 }
4318
4319 static char *
emacs_setlocale(int category,char const * locale)4320 emacs_setlocale (int category, char const *locale)
4321 {
4322 # ifdef HAVE_SETLOCALE
4323 errno = 0;
4324 char *loc = setlocale (category, locale);
4325 if (loc || errno)
4326 return loc;
4327 errno = EINVAL;
4328 # else
4329 errno = ENOTSUP;
4330 # endif
4331 return 0;
4332 }
4333
4334 static int
wcscoll_l(wchar_t const * a,wchar_t const * b,locale_t loc)4335 wcscoll_l (wchar_t const *a, wchar_t const *b, locale_t loc)
4336 {
4337 int result = 0;
4338 char *oldloc = emacs_setlocale (LC_COLLATE, NULL);
4339 int err;
4340
4341 if (! oldloc)
4342 err = errno;
4343 else
4344 {
4345 USE_SAFE_ALLOCA;
4346 char *oldcopy = SAFE_ALLOCA (strlen (oldloc) + 1);
4347 strcpy (oldcopy, oldloc);
4348 if (! emacs_setlocale (LC_COLLATE, loc))
4349 err = errno;
4350 else
4351 {
4352 errno = 0;
4353 result = wcscoll (a, b);
4354 err = errno;
4355 if (! emacs_setlocale (LC_COLLATE, oldcopy))
4356 err = errno;
4357 }
4358 SAFE_FREE ();
4359 }
4360
4361 errno = err;
4362 return result;
4363 }
4364
4365 static wint_t
towlower_l(wint_t wc,locale_t loc)4366 towlower_l (wint_t wc, locale_t loc)
4367 {
4368 wint_t result = wc;
4369 char *oldloc = emacs_setlocale (LC_CTYPE, NULL);
4370
4371 if (oldloc)
4372 {
4373 USE_SAFE_ALLOCA;
4374 char *oldcopy = SAFE_ALLOCA (strlen (oldloc) + 1);
4375 strcpy (oldcopy, oldloc);
4376 if (emacs_setlocale (LC_CTYPE, loc))
4377 {
4378 result = towlower (wc);
4379 emacs_setlocale (LC_COLLATE, oldcopy);
4380 }
4381 SAFE_FREE ();
4382 }
4383
4384 return result;
4385 }
4386 # endif
4387
4388 int
str_collate(Lisp_Object s1,Lisp_Object s2,Lisp_Object locale,Lisp_Object ignore_case)4389 str_collate (Lisp_Object s1, Lisp_Object s2,
4390 Lisp_Object locale, Lisp_Object ignore_case)
4391 {
4392 int res, err;
4393 ptrdiff_t len, i, i_byte;
4394 wchar_t *p1, *p2;
4395
4396 USE_SAFE_ALLOCA;
4397
4398 /* Convert byte stream to code points. */
4399 len = SCHARS (s1); i = i_byte = 0;
4400 SAFE_NALLOCA (p1, 1, len + 1);
4401 while (i < len)
4402 {
4403 wchar_t *p = &p1[i];
4404 *p = fetch_string_char_advance (s1, &i, &i_byte);
4405 }
4406 p1[len] = 0;
4407
4408 len = SCHARS (s2); i = i_byte = 0;
4409 SAFE_NALLOCA (p2, 1, len + 1);
4410 while (i < len)
4411 {
4412 wchar_t *p = &p2[i];
4413 *p = fetch_string_char_advance (s2, &i, &i_byte);
4414 }
4415 p2[len] = 0;
4416
4417 if (STRINGP (locale))
4418 {
4419 locale_t loc = newlocale (LC_COLLATE_MASK | LC_CTYPE_MASK,
4420 SSDATA (locale), 0);
4421 if (!loc)
4422 error ("Invalid locale %s: %s", SSDATA (locale), emacs_strerror (errno));
4423
4424 if (! NILP (ignore_case))
4425 for (int i = 1; i < 3; i++)
4426 {
4427 wchar_t *p = (i == 1) ? p1 : p2;
4428 for (; *p; p++)
4429 *p = towlower_l (*p, loc);
4430 }
4431
4432 errno = 0;
4433 res = wcscoll_l (p1, p2, loc);
4434 err = errno;
4435 freelocale (loc);
4436 }
4437 else
4438 {
4439 if (! NILP (ignore_case))
4440 for (int i = 1; i < 3; i++)
4441 {
4442 wchar_t *p = (i == 1) ? p1 : p2;
4443 for (; *p; p++)
4444 *p = towlower (*p);
4445 }
4446
4447 errno = 0;
4448 res = wcscoll (p1, p2);
4449 err = errno;
4450 }
4451 # ifndef HAVE_NEWLOCALE
4452 if (err)
4453 error ("Invalid locale or string for collation: %s", emacs_strerror (err));
4454 # else
4455 if (err)
4456 error ("Invalid string for collation: %s", emacs_strerror (err));
4457 # endif
4458
4459 SAFE_FREE ();
4460 return res;
4461 }
4462 #endif /* __STDC_ISO_10646__ */
4463
4464 #ifdef WINDOWSNT
4465 int
str_collate(Lisp_Object s1,Lisp_Object s2,Lisp_Object locale,Lisp_Object ignore_case)4466 str_collate (Lisp_Object s1, Lisp_Object s2,
4467 Lisp_Object locale, Lisp_Object ignore_case)
4468 {
4469
4470 char *loc = STRINGP (locale) ? SSDATA (locale) : NULL;
4471 int res, err = errno;
4472
4473 errno = 0;
4474 res = w32_compare_strings (SSDATA (s1), SSDATA (s2), loc, !NILP (ignore_case));
4475 if (errno)
4476 error ("Invalid string for collation: %s", strerror (errno));
4477
4478 errno = err;
4479 return res;
4480 }
4481 #endif /* WINDOWSNT */
4482
4483 void
syms_of_sysdep(void)4484 syms_of_sysdep (void)
4485 {
4486 defsubr (&Sget_internal_run_time);
4487 }
4488