X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/40a03df45353692f73364e488c962f1a7cf2e8bc..63750fd4ed4ff8bb9b3ff8868d4e36e3422adb21:/src/process.c diff --git a/src/process.c b/src/process.c index 0dfe162297..bdbdefabb6 100644 --- a/src/process.c +++ b/src/process.c @@ -130,10 +130,10 @@ extern int sys_select (int, fd_set *, fd_set *, fd_set *, struct timespec *, void *); #endif -/* Work around GCC 4.7.0 bug with strict overflow checking; see +/* Work around GCC 4.3.0 bug with strict overflow checking; see . This bug appears to be fixed in GCC 5.1, so don't work around it there. */ -#if __GNUC__ == 4 && __GNUC_MINOR__ >= 3 +#if GNUC_PREREQ (4, 3, 0) && ! GNUC_PREREQ (5, 1, 0) # pragma GCC diagnostic ignored "-Wstrict-overflow" #endif @@ -150,6 +150,21 @@ bool inhibit_sentinels; #ifndef SOCK_CLOEXEC # define SOCK_CLOEXEC 0 #endif +#ifndef SOCK_NONBLOCK +# define SOCK_NONBLOCK 0 +#endif + +/* True if ERRNUM represents an error where the system call would + block if a blocking variant were used. */ +static bool +would_block (int errnum) +{ +#ifdef EWOULDBLOCK + if (EWOULDBLOCK != EAGAIN && errnum == EWOULDBLOCK) + return true; +#endif + return errnum == EAGAIN; +} #ifndef HAVE_ACCEPT4 @@ -304,7 +319,6 @@ static struct sockaddr_and_len { XPROCESS (proc)->infd >= 0 && \ datagram_address[XPROCESS (proc)->infd].sa != 0) #else -#define DATAGRAM_CHAN_P(chan) (0) #define DATAGRAM_CONN_P(proc) (0) #endif @@ -519,25 +533,37 @@ status_convert (int w) return Qrun; } +/* True if STATUS is that of a process attempting connection. */ + +static bool +connecting_status (Lisp_Object status) +{ + return CONSP (status) && EQ (XCAR (status), Qconnect); +} + /* Given a status-list, extract the three pieces of information and store them individually through the three pointers. */ static void -decode_status (Lisp_Object l, Lisp_Object *symbol, int *code, bool *coredump) +decode_status (Lisp_Object l, Lisp_Object *symbol, Lisp_Object *code, + bool *coredump) { Lisp_Object tem; + if (connecting_status (l)) + l = XCAR (l); + if (SYMBOLP (l)) { *symbol = l; - *code = 0; + *code = make_number (0); *coredump = 0; } else { *symbol = XCAR (l); tem = XCDR (l); - *code = XFASTINT (XCAR (tem)); + *code = XCAR (tem); tem = XCDR (tem); *coredump = !NILP (tem); } @@ -549,8 +575,7 @@ static Lisp_Object status_message (struct Lisp_Process *p) { Lisp_Object status = p->status; - Lisp_Object symbol; - int code; + Lisp_Object symbol, code; bool coredump; Lisp_Object string; @@ -560,7 +585,7 @@ status_message (struct Lisp_Process *p) { char const *signame; synchronize_system_messages_locale (); - signame = strsignal (code); + signame = strsignal (XFASTINT (code)); if (signame == 0) string = build_string ("unknown"); else @@ -582,20 +607,20 @@ status_message (struct Lisp_Process *p) else if (EQ (symbol, Qexit)) { if (NETCONN1_P (p)) - return build_string (code == 0 ? "deleted\n" : "connection broken by remote peer\n"); - if (code == 0) + return build_string (XFASTINT (code) == 0 + ? "deleted\n" + : "connection broken by remote peer\n"); + if (XFASTINT (code) == 0) return build_string ("finished\n"); AUTO_STRING (prefix, "exited abnormally with code "); - string = Fnumber_to_string (make_number (code)); + string = Fnumber_to_string (code); AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n"); return concat3 (prefix, string, suffix); } else if (EQ (symbol, Qfailed)) { - AUTO_STRING (prefix, "failed with code "); - string = Fnumber_to_string (make_number (code)); - AUTO_STRING (suffix, "\n"); - return concat3 (prefix, string, suffix); + AUTO_STRING (format, "failed with code %s\n"); + return CALLN (Fformat, format, code); } else return Fcopy_sequence (Fsymbol_name (symbol)); @@ -1134,7 +1159,9 @@ See `set-process-sentinel' for more info on sentinels. */) DEFUN ("set-process-window-size", Fset_process_window_size, Sset_process_window_size, 3, 3, 0, - doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */) + doc: /* Tell PROCESS that it has logical window size WIDTH by HEIGHT. +Value is t if PROCESS was successfully told about the window size, +nil otherwise. */) (Lisp_Object process, Lisp_Object height, Lisp_Object width) { CHECK_PROCESS (process); @@ -2327,6 +2354,16 @@ conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len) return address; } +/* Convert an internal struct addrinfo to a Lisp object. */ + +static Lisp_Object +conv_addrinfo_to_lisp (struct addrinfo *res) +{ + Lisp_Object protocol = make_number (res->ai_protocol); + eassert (XINT (protocol) == res->ai_protocol); + return Fcons (protocol, conv_sockaddr_to_lisp (res->ai_addr, res->ai_addrlen)); +} + /* Get family and required size for sockaddr structure to hold ADDRESS. */ @@ -3081,14 +3118,13 @@ finish_after_tls_connection (Lisp_Object proc) #endif static void -connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses, +connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, Lisp_Object use_external_socket_p) { ptrdiff_t count = SPECPDL_INDEX (); ptrdiff_t count1; int s = -1, outch, inch; int xerrno = 0; - Lisp_Object ip_address; int family; struct sockaddr *sa = NULL; int ret; @@ -3110,10 +3146,12 @@ connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses, count1 = SPECPDL_INDEX (); s = -1; - while (!NILP (ip_addresses)) + while (!NILP (addrinfos)) { - ip_address = XCAR (ip_addresses); - ip_addresses = XCDR (ip_addresses); + Lisp_Object addrinfo = XCAR (addrinfos); + addrinfos = XCDR (addrinfos); + int protocol = XINT (XCAR (addrinfo)); + Lisp_Object ip_address = XCDR (addrinfo); #ifdef WINDOWSNT retry_connect: @@ -3128,7 +3166,10 @@ connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses, s = socket_to_use; if (s < 0) { - s = socket (family, p->socktype | SOCK_CLOEXEC, p->ai_protocol); + int socktype = p->socktype | SOCK_CLOEXEC; + if (p->is_non_blocking_client) + socktype |= SOCK_NONBLOCK; + s = socket (family, socktype, protocol); if (s < 0) { xerrno = errno; @@ -3136,12 +3177,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses, } } -#ifdef DATAGRAM_SOCKETS - if (!p->is_server && p->socktype == SOCK_DGRAM) - break; -#endif /* DATAGRAM_SOCKETS */ - - if (p->is_non_blocking_client) + if (p->is_non_blocking_client && ! (SOCK_NONBLOCK && socket_to_use < 0)) { ret = fcntl (s, F_SETFL, O_NONBLOCK); if (ret < 0) @@ -3153,6 +3189,11 @@ connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses, } } +#ifdef DATAGRAM_SOCKETS + if (!p->is_server && p->socktype == SOCK_DGRAM) + break; +#endif /* DATAGRAM_SOCKETS */ + /* Make us close S if quit. */ record_unwind_protect_int (close_file_unwind, s); @@ -3258,9 +3299,10 @@ connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses, eassert (FD_ISSET (s, &fdset)); if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0) report_file_error ("Failed getsockopt", Qnil); - if (xerrno) + if (xerrno == 0) + break; + if (NILP (addrinfos)) report_file_errno ("Failed connect", Qnil, xerrno); - break; } #endif /* !WINDOWSNT */ @@ -3369,7 +3411,9 @@ connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses, /* We may get here if connect did succeed immediately. However, in that case, we still need to signal this like a non-blocking connection. */ - pset_status (p, Qconnect); + if (! (connecting_status (p->status) + && EQ (XCDR (p->status), addrinfos))) + pset_status (p, Fcons (Qconnect, addrinfos)); if (!FD_ISSET (inch, &connect_wait_mask)) { FD_SET (inch, &connect_wait_mask); @@ -3605,10 +3649,10 @@ usage: (make-network-process &rest ARGS) */) Lisp_Object tem; Lisp_Object name, buffer, host, service, address; Lisp_Object filter, sentinel, use_external_socket_p; - Lisp_Object ip_addresses = Qnil; + Lisp_Object addrinfos = Qnil; int socktype; int family = -1; - int ai_protocol = 0; + enum { any_protocol = 0 }; #ifdef HAVE_GETADDRINFO_A struct gaicb *dns_request = NULL; #endif @@ -3650,7 +3694,7 @@ usage: (make-network-process &rest ARGS) */) /* :local ADDRESS or :remote ADDRESS */ tem = Fplist_get (contact, QCserver); - if (!NILP (tem)) + if (NILP (tem)) address = Fplist_get (contact, QCremote); else address = Fplist_get (contact, QClocal); @@ -3661,7 +3705,7 @@ usage: (make-network-process &rest ARGS) */) if (!get_lisp_to_sockaddr_size (address, &family)) error ("Malformed :address"); - ip_addresses = list1 (address); + addrinfos = list1 (Fcons (make_number (any_protocol), address)); goto open_socket; } @@ -3725,7 +3769,7 @@ usage: (make-network-process &rest ARGS) */) CHECK_STRING (service); if (sizeof address_un.sun_path <= SBYTES (service)) error ("Service name too long"); - ip_addresses = list1 (service); + addrinfos = list1 (Fcons (make_number (any_protocol), service)); goto open_socket; } #endif @@ -3826,14 +3870,9 @@ usage: (make-network-process &rest ARGS) */) immediate_quit = 0; for (lres = res; lres; lres = lres->ai_next) - { - ip_addresses = Fcons (conv_sockaddr_to_lisp - (lres->ai_addr, lres->ai_addrlen), - ip_addresses); - ai_protocol = lres->ai_protocol; - } + addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos); - ip_addresses = Fnreverse (ip_addresses); + addrinfos = Fnreverse (addrinfos); freeaddrinfo (res); @@ -3900,7 +3939,6 @@ usage: (make-network-process &rest ARGS) */) p->is_server = false; p->port = port; p->socktype = socktype; - p->ai_protocol = ai_protocol; #ifdef HAVE_GETADDRINFO_A p->dns_request = NULL; #endif @@ -3910,7 +3948,7 @@ usage: (make-network-process &rest ARGS) */) p->gnutls_boot_parameters = tem; #endif - set_network_socket_coding_system (proc, service, host, name); + set_network_socket_coding_system (proc, host, service, name); unbind_to (count, Qnil); @@ -3933,15 +3971,15 @@ usage: (make-network-process &rest ARGS) */) #ifdef HAVE_GETADDRINFO_A /* With async address resolution, the list of addresses is empty, so postpone connecting to the server. */ - if (!p->is_server && NILP (ip_addresses)) + if (!p->is_server && NILP (addrinfos)) { p->dns_request = dns_request; - p->status = Qconnect; + p->status = list1 (Qconnect); return proc; } #endif - connect_network_socket (proc, ip_addresses, use_external_socket_p); + connect_network_socket (proc, addrinfos, use_external_socket_p); return proc; } @@ -4278,19 +4316,6 @@ Data that is unavailable is returned as nil. */) #endif } -/* If program file NAME starts with /: for quoting a magic - name, remove that, preserving the multibyteness of NAME. */ - -Lisp_Object -remove_slash_colon (Lisp_Object name) -{ - return - ((SBYTES (name) > 2 && SREF (name, 0) == '/' && SREF (name, 1) == ':') - ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2, - SBYTES (name) - 2, STRING_MULTIBYTE (name)) - : name); -} - /* Turn off input and output for process PROC. */ static void @@ -4464,15 +4489,7 @@ server_accept_connection (Lisp_Object server, int channel) if (s < 0) { int code = errno; - - if (code == EAGAIN) - return; -#ifdef EWOULDBLOCK - if (code == EWOULDBLOCK) - return; -#endif - - if (!NILP (ps->log)) + if (!would_block (code) && !NILP (ps->log)) call3 (ps->log, server, Qnil, concat3 (build_string ("accept failed with code"), Fnumber_to_string (make_number (code)), @@ -4649,7 +4666,7 @@ static Lisp_Object check_for_dns (Lisp_Object proc) { struct Lisp_Process *p = XPROCESS (proc); - Lisp_Object ip_addresses = Qnil; + Lisp_Object addrinfos = Qnil; /* Sanity check. */ if (! p->dns_request) @@ -4665,16 +4682,12 @@ check_for_dns (Lisp_Object proc) struct addrinfo *res; for (res = p->dns_request->ar_result; res; res = res->ai_next) - { - ip_addresses = Fcons (conv_sockaddr_to_lisp - (res->ai_addr, res->ai_addrlen), - ip_addresses); - } + addrinfos = Fcons (conv_addrinfo_to_lisp (res), addrinfos); - ip_addresses = Fnreverse (ip_addresses); + addrinfos = Fnreverse (addrinfos); } /* The DNS lookup failed. */ - else if (EQ (p->status, Qconnect)) + else if (connecting_status (p->status)) { deactivate_process (proc); pset_status (p, (list2 @@ -4687,10 +4700,10 @@ check_for_dns (Lisp_Object proc) free_dns_request (proc); /* This process should not already be connected (or killed). */ - if (!EQ (p->status, Qconnect)) + if (! connecting_status (p->status)) return Qnil; - return ip_addresses; + return addrinfos; } #endif /* HAVE_GETADDRINFO_A */ @@ -4699,7 +4712,7 @@ static void wait_for_socket_fds (Lisp_Object process, char const *name) { while (XPROCESS (process)->infd < 0 - && EQ (XPROCESS (process)->status, Qconnect)) + && connecting_status (XPROCESS (process)->status)) { add_to_log ("Waiting for socket from %s...", build_string (name)); wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0); @@ -4709,7 +4722,7 @@ wait_for_socket_fds (Lisp_Object process, char const *name) static void wait_while_connecting (Lisp_Object process) { - while (EQ (XPROCESS (process)->status, Qconnect)) + while (connecting_status (XPROCESS (process)->status)) { add_to_log ("Waiting for connection..."); wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0); @@ -4873,9 +4886,9 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, /* Check for pending DNS requests. */ if (p->dns_request) { - Lisp_Object ip_addresses = check_for_dns (aproc); - if (!NILP (ip_addresses) && !EQ (ip_addresses, Qt)) - connect_network_socket (aproc, ip_addresses, Qnil); + Lisp_Object addrinfos = check_for_dns (aproc); + if (!NILP (addrinfos) && !EQ (addrinfos, Qt)) + connect_network_socket (aproc, addrinfos, Qnil); else retry_for_async = true; } @@ -5011,7 +5024,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, update_status (wait_proc); if (wait_proc && ! EQ (wait_proc->status, Qrun) - && ! EQ (wait_proc->status, Qconnect)) + && ! connecting_status (wait_proc->status)) { bool read_some_bytes = false; @@ -5027,12 +5040,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, int nread = read_process_output (proc, wait_proc->infd); if (nread < 0) { - if (errno == EIO || errno == EAGAIN) - break; -#ifdef EWOULDBLOCK - if (errno == EWOULDBLOCK) - break; -#endif + if (errno == EIO || would_block (errno)) + break; } else { @@ -5260,16 +5269,22 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, haven't lowered our timeout due to timers or SIGIO and have waited a long amount of time due to repeated timers. */ + struct timespec huge_timespec + = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_RESOLUTION); + struct timespec cmp_time = huge_timespec; if (wait < TIMEOUT) break; - struct timespec cmp_time - = (wait == TIMEOUT - ? end_time - : (!process_skipped && got_some_output > 0 - && (timeout.tv_sec > 0 || timeout.tv_nsec > 0)) - ? got_output_end_time - : invalid_timespec ()); - if (timespec_valid_p (cmp_time)) + if (wait == TIMEOUT) + cmp_time = end_time; + if (!process_skipped && got_some_output > 0 + && (timeout.tv_sec > 0 || timeout.tv_nsec > 0)) + { + if (!timespec_valid_p (got_output_end_time)) + break; + if (timespec_cmp (got_output_end_time, cmp_time) < 0) + cmp_time = got_output_end_time; + } + if (timespec_cmp (cmp_time, huge_timespec) < 0) { now = current_timespec (); if (timespec_cmp (cmp_time, now) <= 0) @@ -5416,11 +5431,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (do_display) redisplay_preserve_echo_area (12); } -#ifdef EWOULDBLOCK - else if (nread == -1 && errno == EWOULDBLOCK) - ; -#endif - else if (nread == -1 && errno == EAGAIN) + else if (nread == -1 && would_block (errno)) ; #ifdef WINDOWSNT /* FIXME: Is this special case still needed? */ @@ -5501,15 +5512,16 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, p = XPROCESS (proc); -#ifdef GNU_LINUX - /* getsockopt(,,SO_ERROR,,) is said to hang on some systems. - So only use it on systems where it is known to work. */ +#ifndef WINDOWSNT { socklen_t xlen = sizeof (xerrno); if (getsockopt (channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen)) xerrno = errno; } #else + /* On MS-Windows, getsockopt clears the error for the + entire process, which may not be the right thing; see + w32.c. Use getpeername instead. */ { struct sockaddr pname; socklen_t pnamelen = sizeof (pname); @@ -5528,9 +5540,18 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, #endif if (xerrno) { - p->tick = ++process_tick; - pset_status (p, list2 (Qfailed, make_number (xerrno))); + Lisp_Object addrinfos + = connecting_status (p->status) ? XCDR (p->status) : Qnil; + if (!NILP (addrinfos)) + XSETCDR (p->status, XCDR (addrinfos)); + else + { + p->tick = ++process_tick; + pset_status (p, list2 (Qfailed, make_number (xerrno))); + } deactivate_process (proc); + if (!NILP (addrinfos)) + connect_network_socket (proc, addrinfos, Qnil); } else { @@ -6158,11 +6179,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, if (rv < 0) { - if (errno == EAGAIN -#ifdef EWOULDBLOCK - || errno == EWOULDBLOCK -#endif - ) + if (would_block (errno)) /* Buffer is full. Wait, accepting input; that may allow the program to finish doing output and read more. */ @@ -7011,7 +7028,7 @@ status_notify (struct Lisp_Process *deleting_process, /* If process is still active, read any output that remains. */ while (! EQ (p->filter, Qt) - && ! EQ (p->status, Qconnect) + && ! connecting_status (p->status) && ! EQ (p->status, Qlisten) /* Network or serial process not stopped: */ && ! EQ (p->command, Qt) @@ -7483,6 +7500,19 @@ add_timer_wait_descriptor (int fd) #endif /* HAVE_TIMERFD */ +/* If program file NAME starts with /: for quoting a magic + name, remove that, preserving the multibyteness of NAME. */ + +Lisp_Object +remove_slash_colon (Lisp_Object name) +{ + return + ((SBYTES (name) > 2 && SREF (name, 0) == '/' && SREF (name, 1) == ':') + ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2, + SBYTES (name) - 2, STRING_MULTIBYTE (name)) + : name); +} + /* Add DESC to the set of keyboard input descriptors. */ void @@ -8010,13 +8040,6 @@ The variable takes effect when `start-process' is called. */); defsubr (&Sset_process_filter_multibyte); defsubr (&Sprocess_filter_multibyte_p); -#endif /* subprocesses */ - - defsubr (&Sget_buffer_process); - defsubr (&Sprocess_inherit_coding_system_flag); - defsubr (&Slist_system_processes); - defsubr (&Sprocess_attributes); - { Lisp_Object subfeatures = Qnil; const struct socket_options *sopt; @@ -8049,4 +8072,10 @@ The variable takes effect when `start-process' is called. */); Fprovide (intern_c_string ("make-network-process"), subfeatures); } +#endif /* subprocesses */ + + defsubr (&Sget_buffer_process); + defsubr (&Sprocess_inherit_coding_system_flag); + defsubr (&Slist_system_processes); + defsubr (&Sprocess_attributes); }