* Re: Non-blocking open-network-stream
[not found] <m2u1sa7819.fsf@xaital.online-marketwatch.com>
@ 2002-02-21 23:45 ` Kim F. Storm
2002-02-22 16:04 ` Stefan Monnier
2002-02-25 22:38 ` Kim F. Storm
0 siblings, 2 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-02-21 23:45 UTC (permalink / raw)
Cc: emacs-devel
Helmut Eller <helmut@xaital.km4u.net> writes:
> Hi,
>
> I read your post about non-blocking open-network-stream in the web
> archive of the emacs-devel list and would like to make some comments.
> I write to you directly because I'm not subscribed and I have the
> impression the list is "For Developers Only".
>
Thanks a lot for your feedback. I've copied my response to the list.
> I tried the code a bit and I noticed that the sentinel is sometimes
> not invoked with "run" when the connections completes successfully but
> is closed shortly afterwards by the peer. The sentinel was sometimes
> invoked sometimes not. The scenario was very simple: a server
> accepted the connection and wrote "hello" to the socket and closed the
> connection. Emacs executed this:
>
> (open-network-stream "nb" "x.x" "localhost" 34567
> nil
> (lambda (s msg)
> (with-current-buffer (process-buffer s)
> (insert msg "\n")
> (when (equal "failed" msg)
> (message "deleting %S" s)
> (delete-process s))))
> t)
>
This seems to be related to the problem you describe below:
reading the process output before checking for the completion of the
connect. I'll look into it.
> You wrote:
>
> [...]
> > The initial process-state is `connecting' which changes to `open'
> > or `failed' depending on whether the connect succeeded or failed.
> > Notice that the sentinel string for `open' is "run".
>
> You could modify status_message to return something more meaningful.
> Preferably the symbol 'open.
>
Yes, I considered doing that. However, I didn't know whether existing
code may depend on the current behaviour, and although I couldn't find any
in CVS, I decided against changing it.
> [...]
> > + /* Number of bits set in connect_wait_mask. */
> > + int num_pending_connects;
> > +
>
> Any reason to make this non-static?
No. I just forgot it.
>
> [...]
> > ! non_blocking = (NILP (non_blocking) ? Qnil : Qt);
> > ! #ifdef NON_BLOCKING_CONNECT
> > ! is_non_blocking = !NILP (non_blocking);
> > ! #else
> > ! is_non_blocking = 0;
> > ! #endif
>
> Wouldn't non_blocking_p be a more lispy name? :-)
Yes - but is_non_blocking is not a lisp object :-)
>
> [...]
> > --- 1948,1971 ----
> > turn_on_atimers (1);
> >
> > if (ret == 0 || xerrno == EISCONN)
> > ! {
> > ! is_non_blocking = 0;
> > ! /* The unwind-protect will be discarded afterwards.
> > ! Likewise for immediate_quit. */
> > ! break;
> > ! }
>
> Why do you set is_non_blocking to 0? I can see no later use. For
> documentation?
It is defensive programming -- in case it ever becomes necessary to test on
it later in the code, it contains the proper value.
>
> > !
> > ! #ifdef NON_BLOCKING_CONNECT
> > ! #ifdef EINPROGRESS
> > ! if (is_non_blocking && xerrno == EINPROGRESS)
> > ! break;
> > ! #else
> > ! #ifdef EWOULDBLOCK
> > ! if (is_non_blocking && xerrno == EWOULDBLOCK)
> > break;
> > + #endif
> > + #endif
>
> What does it mean when connect returns EWOULDBLOCK? My man page
> doesn't mention it.
>
Neither does mine -- but I saw some references on the Web which
mentions this as one of the possible error codes from a non-blocking
connect. So I included the test in case EINPROGRESS is not defined.
> [...]
> > --- 2176,2202 ----
> [...]
> > ! if (!NILP (non_blocking))
> > ! {
> > ! XPROCESS (proc)->status = Qconnecting;
> > ! if (!FD_ISSET (inch, &connect_wait_mask))
> > ! {
> > ! FD_SET (inch, &connect_wait_mask);
> > ! num_pending_connects++;
> > ! }
> > ! }
>
> Why is if(!FD_ISET...) necessary?
Because num_pending_connects would be updated incorrectly if
it is already set. Defensive programming...
>
> [...]
> > + #ifdef NON_BLOCKING_CONNECT
> > + if (check_connect && FD_ISSET (channel, &Connecting))
> > + {
>
> Isn't it possible that channel becomes readable and writable at the
> same time? If yes, wouldn't that mean that read_process_output (and
> hence the filter) was already called before we get here?
It seems you are right. Maybe the easiest fix would be for
read_process_output to just return 0 if the process state is
Qconnecting. I'll look into that.
>
> > + struct Lisp_Process *p;
> > + struct sockaddr pname;
> > + socklen_t pnamelen = sizeof(pname);
> > +
> > + FD_CLR (channel, &connect_wait_mask);
> > + if (--num_pending_connects < 0)
> > + abort ();
> > +
> > + proc = chan_process[channel];
> > + if (NILP (proc))
> > + continue;
>
> Is it safe to decrement num_pending_connects even if proc is nil?
>
> [...]
Yes, because we only get here if channel is in the Connecting mask
which is a subset of connect_wait_mask. Whether there really is a
corresponding process doesn't matter. (there should be one, but I'm
playing safe here -- cleaning up the connect_wait_mask in any case).
> > +
> > + p = XPROCESS (proc);
> > + XSETINT (p->tick, ++process_tick);
> > +
> > + /* If connection failed, getpeername fails */
> > + if (getpeername(channel, &pname, &pnamelen) < 0)
> > + {
> > + /* Preserve status of processes already terminated. */
> > + p->status = Qfailed;
> > + deactivate_process (proc);
> > + }
> > + else
>
> It would be nice if the error message (obtained with getsockopt
> (channel, SOL_SCOKET, SO_ERROR ...)) would be passed to the sentinel.
>
That would be reasonable. I'll look into that.
> A minor note: open-network-stream contains a large chunk of duplicated
> code (starting from "/* Kernel bugs (on Ultrix..." to
> "report_file_error ("connection failed...))). This are about 70 lines;
> should they be in a separate function?
Maybe, or the #ifdefs could be rearranged to avoid the duplication.
I'll take a look.
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-02-21 23:45 ` Non-blocking open-network-stream Kim F. Storm
@ 2002-02-22 16:04 ` Stefan Monnier
2002-02-25 22:38 ` Kim F. Storm
1 sibling, 0 replies; 46+ messages in thread
From: Stefan Monnier @ 2002-02-22 16:04 UTC (permalink / raw)
Cc: Helmut Eller, emacs-devel
> > > ! non_blocking = (NILP (non_blocking) ? Qnil : Qt);
> > > ! #ifdef NON_BLOCKING_CONNECT
> > > ! is_non_blocking = !NILP (non_blocking);
> > > ! #else
> > > ! is_non_blocking = 0;
> > > ! #endif
> >
> > Wouldn't non_blocking_p be a more lispy name? :-)
> Yes - but is_non_blocking is not a lisp object :-)
Actually the answer was `no'. The `p' postfix stands for `predicate'.
A predicate is not a mere boolean value but a function that returns a boolean.
Stefan
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-02-21 23:45 ` Non-blocking open-network-stream Kim F. Storm
2002-02-22 16:04 ` Stefan Monnier
@ 2002-02-25 22:38 ` Kim F. Storm
2002-02-26 22:46 ` Helmut Eller
1 sibling, 1 reply; 46+ messages in thread
From: Kim F. Storm @ 2002-02-25 22:38 UTC (permalink / raw)
Cc: Helmut Eller
Here is my second attempt at a patch to support non-blocking
open-network-stream.
If I don't receive any comments on this, I'll install it later
this week.
Index: process.c
===================================================================
RCS file: /cvs/emacs/src/process.c,v
retrieving revision 1.351
diff -c -r1.351 process.c
*** process.c 7 Jan 2002 21:16:38 -0000 1.351
--- process.c 25 Feb 2002 22:33:22 -0000
***************
*** 1,6 ****
/* Asynchronous subprocess control for GNU Emacs.
! Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999, 2001
! Free Software Foundation, Inc.
This file is part of GNU Emacs.
--- 1,6 ----
/* Asynchronous subprocess control for GNU Emacs.
! Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999,
! 2001, 2002 Free Software Foundation, Inc.
This file is part of GNU Emacs.
***************
*** 112,118 ****
#include "atimer.h"
Lisp_Object Qprocessp;
! Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed;
Lisp_Object Qlast_nonmenu_event;
/* Qexit is declared and initialized in eval.c. */
--- 112,119 ----
#include "atimer.h"
Lisp_Object Qprocessp;
! Lisp_Object Qrun, Qstop, Qsignal;
! Lisp_Object Qopen, Qclosed, Qconnect, Qfailed;
Lisp_Object Qlast_nonmenu_event;
/* Qexit is declared and initialized in eval.c. */
***************
*** 173,178 ****
--- 174,199 ----
/* Number of events for which the user or sentinel has been notified. */
int update_tick;
+ /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
+
+ #ifdef BROKEN_NON_BLOCKING_CONNECT
+ #undef NON_BLOCKING_CONNECT
+ #else
+ #ifndef NON_BLOCKING_CONNECT
+ #ifdef HAVE_SOCKETS
+ #ifdef HAVE_SELECT
+ #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
+ #if defined (O_NONBLOCK) || defined (O_NDELAY)
+ #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
+ #define NON_BLOCKING_CONNECT
+ #endif /* EWOULDBLOCK || EINPROGRESS */
+ #endif /* O_NONBLOCK || O_NDELAY */
+ #endif /* HAVE_GETPEERNAME || GNU_LINUX */
+ #endif /* HAVE_SELECT */
+ #endif /* HAVE_SOCKETS */
+ #endif /* NON_BLOCKING_CONNECT */
+ #endif /* BROKEN_NON_BLOCKING_CONNECT */
+
#include "sysselect.h"
extern int keyboard_bit_set P_ ((SELECT_TYPE *));
***************
*** 195,200 ****
--- 216,230 ----
static SELECT_TYPE non_process_wait_mask;
+ /* Mask of bits indicating the descriptors that we wait for connect to
+ complete on. Once they complete, they are removed from this mask
+ and added to the input_wait_mask and non_keyboard_wait_mask. */
+
+ static SELECT_TYPE connect_wait_mask;
+
+ /* Number of bits set in connect_wait_mask. */
+ static int num_pending_connects;
+
/* The largest descriptor currently in use for a process object. */
static int max_process_desc;
***************
*** 335,340 ****
--- 365,377 ----
return concat2 (build_string ("exited abnormally with code "),
concat2 (string, string2));
}
+ else if (EQ (symbol, Qfailed))
+ {
+ string = Fnumber_to_string (make_number (code));
+ string2 = build_string ("\n");
+ return concat2 (build_string ("failed with code "),
+ concat2 (string, string2));
+ }
else
return Fcopy_sequence (Fsymbol_name (symbol));
}
***************
*** 1741,1762 ****
deactivate and close it via delete-process */
DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
! 4, 4, 0,
doc: /* Open a TCP connection for a service to a host.
Returns a subprocess-object to represent the connection.
Input and output work as for subprocesses; `delete-process' closes it.
! Args are NAME BUFFER HOST SERVICE.
NAME is name for process. It is modified if necessary to make it unique.
BUFFER is the buffer (or buffer-name) to associate with the process.
Process output goes at end of that buffer, unless you specify
an output stream or filter function to handle the output.
BUFFER may be also nil, meaning that this process is not associated
! with any buffer
! Third arg is name of the host to connect to, or its IP address.
! Fourth arg SERVICE is name of the service desired, or an integer
! specifying a port number to connect to. */)
! (name, buffer, host, service)
! Lisp_Object name, buffer, host, service;
{
Lisp_Object proc;
#ifdef HAVE_GETADDRINFO
--- 1778,1809 ----
deactivate and close it via delete-process */
DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
! 4, 7, 0,
doc: /* Open a TCP connection for a service to a host.
Returns a subprocess-object to represent the connection.
Input and output work as for subprocesses; `delete-process' closes it.
! Args are NAME BUFFER HOST SERVICE FILTER SENTINEL NON-BLOCKING.
NAME is name for process. It is modified if necessary to make it unique.
BUFFER is the buffer (or buffer-name) to associate with the process.
Process output goes at end of that buffer, unless you specify
an output stream or filter function to handle the output.
BUFFER may be also nil, meaning that this process is not associated
! with any buffer.
! HOST is name of the host to connect to, or its IP address.
! SERVICE is name of the service desired, or an integer specifying a
! port number to connect to.
! FILTER and SENTINEL are optional args specifying the filter and
! sentinel functions associated with the network stream.
! NON-BLOCKING is optional arg requesting an non-blocking connect.
! When non-nil, open-network-stream will return immediately without
! waiting for the connection to be made. Instead, the sentinel function
! will be called with second arg equal to "run" (if successful) or
! "failed" when the connect completes.
! On systems without non-blocking connect, this function waits
! for the connect to complete and then proceeds emulating a
! non-blocking connect. */)
! (name, buffer, host, service, filter, sentinel, non_blocking)
! Lisp_Object name, buffer, host, service, filter, sentinel, non_blocking;
{
Lisp_Object proc;
#ifdef HAVE_GETADDRINFO
***************
*** 1773,1789 ****
int port;
#endif /* HAVE_GETADDRINFO */
int s = -1, outch, inch;
! struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int retry = 0;
int count = specpdl_ptr - specpdl;
int count1;
#ifdef WINDOWSNT
/* Ensure socket support is loaded if available. */
init_winsock (TRUE);
#endif
! GCPRO4 (name, buffer, host, service);
CHECK_STRING (name);
CHECK_STRING (host);
--- 1820,1846 ----
int port;
#endif /* HAVE_GETADDRINFO */
int s = -1, outch, inch;
! struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
int retry = 0;
int count = specpdl_ptr - specpdl;
int count1;
+ int is_non_blocking;
#ifdef WINDOWSNT
/* Ensure socket support is loaded if available. */
init_winsock (TRUE);
#endif
! non_blocking = (NILP (non_blocking) ? Qnil : Qt);
! #ifdef NON_BLOCKING_CONNECT
! is_non_blocking = !NILP (non_blocking);
! #else
! is_non_blocking = 0;
! #endif
!
! /* Can only GCPRO 5 variables */
! sentinel = Fcons (sentinel, filter);
! GCPRO5 (name, buffer, host, service, sentinel);
CHECK_STRING (name);
CHECK_STRING (host);
***************
*** 1867,1872 ****
--- 1924,1942 ----
count1 = specpdl_ptr - specpdl;
record_unwind_protect (close_file_unwind, make_number (s));
+ #ifdef NON_BLOCKING_CONNECT
+ if (is_non_blocking)
+ {
+ #ifdef O_NONBLOCK
+ ret = fcntl (s, F_SETFL, O_NONBLOCK);
+ #else
+ ret = fcntl (s, F_SETFL, O_NDELAY);
+ #endif
+ if (ret < 0)
+ is_non_blocking = 0;
+ }
+ #endif
+
loop:
immediate_quit = 1;
***************
*** 1885,1893 ****
turn_on_atimers (1);
if (ret == 0 || xerrno == EISCONN)
! /* The unwind-protect will be discarded afterwards.
! Likewise for immediate_quit. */
break;
immediate_quit = 0;
--- 1955,1978 ----
turn_on_atimers (1);
if (ret == 0 || xerrno == EISCONN)
! {
! is_non_blocking = 0;
! /* The unwind-protect will be discarded afterwards.
! Likewise for immediate_quit. */
! break;
! }
!
! #ifdef NON_BLOCKING_CONNECT
! #ifdef EINPROGRESS
! if (is_non_blocking && xerrno == EINPROGRESS)
! break;
! #else
! #ifdef EWOULDBLOCK
! if (is_non_blocking && xerrno == EWOULDBLOCK)
break;
+ #endif
+ #endif
+ #endif
immediate_quit = 0;
***************
*** 1989,2001 ****
if (interrupt_input)
unrequest_sigio ();
loop:
immediate_quit = 1;
QUIT;
! if (connect (s, (struct sockaddr *) &address, sizeof address) == -1
! && errno != EISCONN)
{
int xerrno = errno;
--- 2074,2115 ----
if (interrupt_input)
unrequest_sigio ();
+ #ifdef NON_BLOCKING_CONNECT
+ if (is_non_blocking)
+ {
+ #ifdef O_NONBLOCK
+ ret = fcntl (s, F_SETFL, O_NONBLOCK);
+ #else
+ ret = fcntl (s, F_SETFL, O_NDELAY);
+ #endif
+ if (ret < 0)
+ is_non_blocking = 0;
+ }
+ #endif /* NON_BLOCKING_CONNECT */
+
loop:
immediate_quit = 1;
QUIT;
! ret = connect (s, (struct sockaddr *) &address, sizeof address);
!
! if (ret == 0 || errno == EISCONN)
! {
! is_non_blocking = 0;
! }
! #ifdef NON_BLOCKING_CONNECT
! #ifdef EINPROGRESS
! else if (is_non_blocking && ret == -1 && errno == EINPROGRESS)
! ;
! #else
! #ifdef EWOULDBLOCK
! else if (is_non_blocking && ret == -1 && errno == EWOULDBLOCK)
! ;
! #endif
! #endif
! #endif
! else
{
int xerrno = errno;
***************
*** 2041,2046 ****
--- 2155,2161 ----
request_sigio ();
#else /* TERM */
+ is_non_blocking = 0;
s = connect_server (0);
if (s < 0)
report_file_error ("error creating socket", Fcons (name, Qnil));
***************
*** 2068,2082 ****
XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
XPROCESS (proc)->command_channel_p = Qnil;
XPROCESS (proc)->buffer = buffer;
! XPROCESS (proc)->sentinel = Qnil;
! XPROCESS (proc)->filter = Qnil;
XPROCESS (proc)->command = Qnil;
XPROCESS (proc)->pid = Qnil;
XSETINT (XPROCESS (proc)->infd, inch);
XSETINT (XPROCESS (proc)->outfd, outch);
XPROCESS (proc)->status = Qrun;
! FD_SET (inch, &input_wait_mask);
! FD_SET (inch, &non_keyboard_wait_mask);
if (inch > max_process_desc)
max_process_desc = inch;
--- 2183,2209 ----
XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
XPROCESS (proc)->command_channel_p = Qnil;
XPROCESS (proc)->buffer = buffer;
! XPROCESS (proc)->sentinel = XCAR (sentinel);
! XPROCESS (proc)->filter = XCDR (sentinel);
XPROCESS (proc)->command = Qnil;
XPROCESS (proc)->pid = Qnil;
XSETINT (XPROCESS (proc)->infd, inch);
XSETINT (XPROCESS (proc)->outfd, outch);
XPROCESS (proc)->status = Qrun;
! if (!NILP (non_blocking))
! {
! XPROCESS (proc)->status = Qconnect;
! if (!FD_ISSET (inch, &connect_wait_mask))
! {
! FD_SET (inch, &connect_wait_mask);
! num_pending_connects++;
! }
! }
! else if (!EQ (XPROCESS (proc)->filter, Qt))
! {
! FD_SET (inch, &input_wait_mask);
! FD_SET (inch, &non_keyboard_wait_mask);
! }
if (inch > max_process_desc)
max_process_desc = inch;
***************
*** 2194,2199 ****
--- 2321,2332 ----
chan_process[inchannel] = Qnil;
FD_CLR (inchannel, &input_wait_mask);
FD_CLR (inchannel, &non_keyboard_wait_mask);
+ if (FD_ISSET (inchannel, &connect_wait_mask))
+ {
+ FD_CLR (inchannel, &connect_wait_mask);
+ if (--num_pending_connects < 0)
+ abort ();
+ }
if (inchannel == max_process_desc)
{
int i;
***************
*** 2358,2367 ****
{
register int channel, nfds;
static SELECT_TYPE Available;
int xerrno;
Lisp_Object proc;
EMACS_TIME timeout, end_time;
- SELECT_TYPE Atemp;
int wait_channel = -1;
struct Lisp_Process *wait_proc = 0;
int got_some_input = 0;
--- 2491,2501 ----
{
register int channel, nfds;
static SELECT_TYPE Available;
+ static SELECT_TYPE Connecting;
+ int check_connect, no_avail;
int xerrno;
Lisp_Object proc;
EMACS_TIME timeout, end_time;
int wait_channel = -1;
struct Lisp_Process *wait_proc = 0;
int got_some_input = 0;
***************
*** 2370,2375 ****
--- 2504,2510 ----
Lisp_Object wait_for_cell = Qnil;
FD_ZERO (&Available);
+ FD_ZERO (&Connecting);
/* If read_kbd is a process to watch, set wait_proc and wait_channel
accordingly. */
***************
*** 2511,2521 ****
timeout to get our attention. */
if (update_tick != process_tick && do_display)
{
Atemp = input_wait_mask;
EMACS_SET_SECS_USECS (timeout, 0, 0);
if ((select (max (max_process_desc, max_keyboard_desc) + 1,
! &Atemp, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
! &timeout)
<= 0))
{
/* It's okay for us to do this and then continue with
--- 2646,2660 ----
timeout to get our attention. */
if (update_tick != process_tick && do_display)
{
+ SELECT_TYPE Atemp, Ctemp;
+
Atemp = input_wait_mask;
+ Ctemp = connect_wait_mask;
EMACS_SET_SECS_USECS (timeout, 0, 0);
if ((select (max (max_process_desc, max_keyboard_desc) + 1,
! &Atemp,
! (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
! (SELECT_TYPE *)0, &timeout)
<= 0))
{
/* It's okay for us to do this and then continue with
***************
*** 2525,2535 ****
}
}
! /* Don't wait for output from a non-running process. */
if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
update_status (wait_proc);
if (wait_proc != 0
! && ! EQ (wait_proc->status, Qrun))
{
int nread, total_nread = 0;
--- 2664,2676 ----
}
}
! /* Don't wait for output from a non-running process. Just
! read whatever data has already been received. */
if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
update_status (wait_proc);
if (wait_proc != 0
! && ! EQ (wait_proc->status, Qrun)
! && ! EQ (wait_proc->status, Qconnect))
{
int nread, total_nread = 0;
***************
*** 2568,2578 ****
/* Wait till there is something to do */
if (!NILP (wait_for_cell))
! Available = non_process_wait_mask;
! else if (! XINT (read_kbd))
! Available = non_keyboard_wait_mask;
else
! Available = input_wait_mask;
/* If frame size has changed or the window is newly mapped,
redisplay now, before we start to wait. There is a race
--- 2709,2726 ----
/* Wait till there is something to do */
if (!NILP (wait_for_cell))
! {
! Available = non_process_wait_mask;
! check_connect = 0;
! }
else
! {
! if (! XINT (read_kbd))
! Available = non_keyboard_wait_mask;
! else
! Available = input_wait_mask;
! check_connect = (num_pending_connects > 0);
! }
/* If frame size has changed or the window is newly mapped,
redisplay now, before we start to wait. There is a race
***************
*** 2587,2601 ****
set_waiting_for_input (&timeout);
}
if (XINT (read_kbd) && detect_input_pending ())
{
nfds = 0;
! FD_ZERO (&Available);
}
else
! nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
! &Available, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
! &timeout);
xerrno = errno;
--- 2735,2755 ----
set_waiting_for_input (&timeout);
}
+ no_avail = 0;
if (XINT (read_kbd) && detect_input_pending ())
{
nfds = 0;
! no_avail = 1;
}
else
! {
! if (check_connect)
! Connecting = connect_wait_mask;
! nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
! &Available,
! (check_connect ? &Connecting : (SELECT_TYPE *)0),
! (SELECT_TYPE *)0, &timeout);
! }
xerrno = errno;
***************
*** 2611,2617 ****
if (nfds < 0)
{
if (xerrno == EINTR)
! FD_ZERO (&Available);
#ifdef ultrix
/* Ultrix select seems to return ENOMEM when it is
interrupted. Treat it just like EINTR. Bleah. Note
--- 2765,2771 ----
if (nfds < 0)
{
if (xerrno == EINTR)
! no_avail = 1;
#ifdef ultrix
/* Ultrix select seems to return ENOMEM when it is
interrupted. Treat it just like EINTR. Bleah. Note
***************
*** 2619,2631 ****
"__ultrix__"; the latter is only defined under GCC, but
not by DEC's bundled CC. -JimB */
else if (xerrno == ENOMEM)
! FD_ZERO (&Available);
#endif
#ifdef ALLIANT
/* This happens for no known reason on ALLIANT.
I am guessing that this is the right response. -- RMS. */
else if (xerrno == EFAULT)
! FD_ZERO (&Available);
#endif
else if (xerrno == EBADF)
{
--- 2773,2785 ----
"__ultrix__"; the latter is only defined under GCC, but
not by DEC's bundled CC. -JimB */
else if (xerrno == ENOMEM)
! no_avail = 1;
#endif
#ifdef ALLIANT
/* This happens for no known reason on ALLIANT.
I am guessing that this is the right response. -- RMS. */
else if (xerrno == EFAULT)
! no_avail = 1;
#endif
else if (xerrno == EBADF)
{
***************
*** 2637,2643 ****
So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
in m/ibmrt-aix.h), and here we just ignore the select error.
Cleanup occurs c/o status_notify after SIGCLD. */
! FD_ZERO (&Available); /* Cannot depend on values returned */
#else
abort ();
#endif
--- 2791,2797 ----
So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
in m/ibmrt-aix.h), and here we just ignore the select error.
Cleanup occurs c/o status_notify after SIGCLD. */
! no_avail = 1; /* Cannot depend on values returned */
#else
abort ();
#endif
***************
*** 2645,2653 ****
else
error ("select error: %s", emacs_strerror (xerrno));
}
#if defined(sun) && !defined(USG5_4)
! else if (nfds > 0 && keyboard_bit_set (&Available)
! && interrupt_input)
/* System sometimes fails to deliver SIGIO.
David J. Mackenzie says that Emacs doesn't compile under
--- 2799,2814 ----
else
error ("select error: %s", emacs_strerror (xerrno));
}
+
+ if (no_avail)
+ {
+ FD_ZERO (&Available);
+ check_connect = 0;
+ }
+
#if defined(sun) && !defined(USG5_4)
! if (nfds > 0 && keyboard_bit_set (&Available)
! && interrupt_input)
/* System sometimes fails to deliver SIGIO.
David J. Mackenzie says that Emacs doesn't compile under
***************
*** 2746,2751 ****
--- 2907,2915 ----
do_pending_window_change (0);
/* Check for data from a process. */
+ if (no_avail || nfds == 0)
+ continue;
+
/* Really FIRST_PROC_DESC should be 0 on Unix,
but this is safer in the short run. */
for (channel = 0; channel <= max_process_desc; channel++)
***************
*** 2837,2842 ****
--- 3001,3047 ----
= Fcons (Qexit, Fcons (make_number (256), Qnil));
}
}
+ #ifdef NON_BLOCKING_CONNECT
+ if (check_connect && FD_ISSET (channel, &Connecting))
+ {
+ struct Lisp_Process *p;
+ struct sockaddr pname;
+ socklen_t pnamelen = sizeof(pname);
+
+ FD_CLR (channel, &connect_wait_mask);
+ if (--num_pending_connects < 0)
+ abort ();
+
+ proc = chan_process[channel];
+ if (NILP (proc))
+ continue;
+
+ p = XPROCESS (proc);
+ XSETINT (p->tick, ++process_tick);
+
+ /* If connection failed, getpeername fails */
+ if (getpeername(channel, &pname, &pnamelen) < 0)
+ {
+ char dummy;
+
+ xerrno = errno;
+ /* Obtain connect failure code through error slippage. */
+ if (errno == ENOTCONN && read(channel, &dummy, 1) < 0)
+ xerrno = errno;
+ p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil));
+ deactivate_process (proc);
+ }
+ else
+ {
+ p->status = Qrun;
+ if (!EQ (p->filter, Qt))
+ {
+ FD_SET (XINT (p->infd), &input_wait_mask);
+ FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
+ }
+ }
+ }
+ #endif /* NON_BLOCKING_CONNECT */
} /* end for each file descriptor */
} /* end while exit conditions not met */
***************
*** 4419,4424 ****
--- 4624,4630 ----
/* If process is still active, read any output that remains. */
while (! EQ (p->filter, Qt)
+ && ! EQ (p->status, Qconnect)
&& XINT (p->infd) >= 0
&& read_process_output (proc, XINT (p->infd)) > 0);
***************
*** 4653,4658 ****
--- 4859,4868 ----
staticpro (&Qopen);
Qclosed = intern ("closed");
staticpro (&Qclosed);
+ Qconnect = intern ("connect");
+ staticpro (&Qconnect);
+ Qfailed = intern ("failed");
+ staticpro (&Qfailed);
Qlast_nonmenu_event = intern ("last-nonmenu-event");
staticpro (&Qlast_nonmenu_event);
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-02-25 22:38 ` Kim F. Storm
@ 2002-02-26 22:46 ` Helmut Eller
2002-02-27 11:59 ` Kim F. Storm
0 siblings, 1 reply; 46+ messages in thread
From: Helmut Eller @ 2002-02-26 22:46 UTC (permalink / raw)
Cc: emacs-devel
storm@cua.dk (Kim F. Storm) writes:
> Here is my second attempt at a patch to support non-blocking
> open-network-stream.
I think the problem I described last time is still present. The
problem is that the filter is invoked before the sentinel. This
happens when the stream is readable immediately after the transition
from connect state to open state.
Consider wait_reading_process_input:
> --- 3001,3047 ----
[...]
> + XSETINT (p->tick, ++process_tick);
> + if (getpeername(channel, &pname, &pnamelen) < 0)
[...]
> + else
> + {
> + p->status = Qrun;
Tick is incremented and status is set to Qrun. Incrementing tick
causes status_notify to be invoked during the next iteration.
But status_notify ...
> --- 4624,4630 ----
[...]
> while (! EQ (p->filter, Qt)
> + && ! EQ (p->status, Qconnect)
> && XINT (p->infd) >= 0
> && read_process_output (proc, XINT (p->infd)) > 0);
... calls read_process_output (and the filter) before the sentinel.
A simple solution is to call the sentinel in
wait_reading_process_input without incrementing tick, e.g.:
--- 3001,3047 ----
...
+ if (getpeername(channel, &pname, &pnamelen) < 0)
+ XSETINT (p->tick, ++process_tick);
...
+ else
+ {
+ p->status = Qrun;
+ exec_sentinel (proc, Qopen);
Another point: is it a problem to pass the error message and not just
the error number to the sentinel?
Helmut.
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-02-26 22:46 ` Helmut Eller
@ 2002-02-27 11:59 ` Kim F. Storm
2002-02-28 4:08 ` Richard Stallman
0 siblings, 1 reply; 46+ messages in thread
From: Kim F. Storm @ 2002-02-27 11:59 UTC (permalink / raw)
Cc: emacs-devel
Helmut Eller <helmut@xaital.km4u.net> writes:
> storm@cua.dk (Kim F. Storm) writes:
>
> > Here is my second attempt at a patch to support non-blocking
> > open-network-stream.
>
> I think the problem I described last time is still present. The
> problem is that the filter is invoked before the sentinel. This
> happens when the stream is readable immediately after the transition
> from connect state to open state.
I've made the chage you suggested. Thanks.
There is a general problem with handling a request for non-blocking connect
on systems which does not support this.
As I have specified this now, open-network-stream will proceed to
emulate a non-blocking connect -- which means that it will block. And
when the connect completes, it continues to pretend that the connect
was non-blocking, so it setup the sentinel to be called after return,
and all that jazz.
I think it would be much cleaner if (open-network-stream ... t) simply
returns nil if it doesn't support non-blocking connect.
Then the code can do some smarter things (like delaying the connect),
and I don't have to mess up the C code with all sorts of hacks to delay
the delivery of a "failed to connect" message on a process which would
not otherwise have to exist.
Does this sound acceptable (since there is currently no code supporting
non-blocking connect, this cannot break anything :-)
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-02-27 11:59 ` Kim F. Storm
@ 2002-02-28 4:08 ` Richard Stallman
2002-03-01 0:21 ` Kim F. Storm
0 siblings, 1 reply; 46+ messages in thread
From: Richard Stallman @ 2002-02-28 4:08 UTC (permalink / raw)
Cc: helmut, emacs-devel
I think it would be much cleaner if (open-network-stream ... t) simply
returns nil if it doesn't support non-blocking connect.
I think that is ok. The program could immediately try a blocking
connect if that is the right thing to do.
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-02-28 4:08 ` Richard Stallman
@ 2002-03-01 0:21 ` Kim F. Storm
2002-03-01 8:01 ` Juanma Barranquero
` (2 more replies)
0 siblings, 3 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-03-01 0:21 UTC (permalink / raw)
Cc: helmut, emacs-devel
Richard Stallman <rms@gnu.org> writes:
> I think it would be much cleaner if (open-network-stream ... t) simply
> returns nil if it doesn't support non-blocking connect.
>
> I think that is ok. The program could immediately try a blocking
> connect if that is the right thing to do.
I have committed the changes to process.c which add the non-blocking
connect support to open-network-stream.
The next "project" in this area is to add Helmut's server sockets.
(do we have papers for that?)
However, I think it can be done via open-network-stream:
If the HOST argument is nil, a server socket is opened which
accepts connections. The sentinel is called - with a newly
created process - whenever a connections is accepted.
There are some details to be worked out here, but we need to
discuss whether we should use this approach or the approach
suggested by Helmut.
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-03-01 0:21 ` Kim F. Storm
@ 2002-03-01 8:01 ` Juanma Barranquero
2002-03-01 10:50 ` Kim F. Storm
2002-03-01 21:23 ` Richard Stallman
2002-03-02 7:59 ` Non-blocking open-network-stream Helmut Eller
2 siblings, 1 reply; 46+ messages in thread
From: Juanma Barranquero @ 2002-03-01 8:01 UTC (permalink / raw)
Cc: rms, helmut, emacs-devel
On 01 Mar 2002 01:21:39 +0100, storm@cua.dk (Kim F. Storm) wrote:
> The next "project" in this area is to add Helmut's server sockets.
> (do we have papers for that?)
>
> However, I think it can be done via open-network-stream:
>
> If the HOST argument is nil, a server socket is opened which
> accepts connections. The sentinel is called - with a newly
> created process - whenever a connections is accepted.
There will be any support for Emacs to act as a server for UDP?
/L/e/k/t/u
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-03-01 8:01 ` Juanma Barranquero
@ 2002-03-01 10:50 ` Kim F. Storm
2002-03-01 17:10 ` Pavel Janík
0 siblings, 1 reply; 46+ messages in thread
From: Kim F. Storm @ 2002-03-01 10:50 UTC (permalink / raw)
Cc: helmut, emacs-devel
Juanma Barranquero <lektu@terra.es> writes:
> On 01 Mar 2002 01:21:39 +0100, storm@cua.dk (Kim F. Storm) wrote:
>
> > The next "project" in this area is to add Helmut's server sockets.
> > (do we have papers for that?)
> >
> > However, I think it can be done via open-network-stream:
> >
> > If the HOST argument is nil, a server socket is opened which
> > accepts connections. The sentinel is called - with a newly
> > created process - whenever a connections is accepted.
>
> There will be any support for Emacs to act as a server for UDP?
I don't even think it can act as a client for UDP currently, so
there is really two tasks here. I'd like to look into that later
if others think that's something we should support.
--
Kim F. Storm http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-03-01 10:50 ` Kim F. Storm
@ 2002-03-01 17:10 ` Pavel Janík
0 siblings, 0 replies; 46+ messages in thread
From: Pavel Janík @ 2002-03-01 17:10 UTC (permalink / raw)
Cc: Juanma Barranquero, helmut, emacs-devel
From: storm@cua.dk (Kim F. Storm)
Date: 01 Mar 2002 11:50:46 +0100
Hi Kim,
> I don't even think it can act as a client for UDP currently, so
> there is really two tasks here. I'd like to look into that later
> if others think that's something we should support.
I think that UDP can wait for some time. The most important thing now is
IMHO some examples for people who would like to use it and extend
Emacs. Multiplication effect...
--
Pavel Janík
So calm down guys. And improving the benchmark might not be a bad idea.
-- Linus Torvalds in linux-kernel
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-03-01 0:21 ` Kim F. Storm
2002-03-01 8:01 ` Juanma Barranquero
@ 2002-03-01 21:23 ` Richard Stallman
2002-03-07 0:08 ` New patch for server sockets and datagram (UDP) support Kim F. Storm
2002-03-02 7:59 ` Non-blocking open-network-stream Helmut Eller
2 siblings, 1 reply; 46+ messages in thread
From: Richard Stallman @ 2002-03-01 21:23 UTC (permalink / raw)
Cc: helmut, emacs-devel
If the HOST argument is nil, a server socket is opened which
accepts connections. The sentinel is called - with a newly
created process - whenever a connections is accepted.
That sounds good to me in principle, if the details work ok.
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-03-01 0:21 ` Kim F. Storm
2002-03-01 8:01 ` Juanma Barranquero
2002-03-01 21:23 ` Richard Stallman
@ 2002-03-02 7:59 ` Helmut Eller
2002-03-03 0:12 ` Kim F. Storm
2002-03-03 14:39 ` Richard Stallman
2 siblings, 2 replies; 46+ messages in thread
From: Helmut Eller @ 2002-03-02 7:59 UTC (permalink / raw)
Cc: emacs-devel
storm@cua.dk (Kim F. Storm) writes:
> (do we have papers for that?)
No. If needed, I will sign papers.
> However, I think it can be done via open-network-stream:
>
> If the HOST argument is nil, a server socket is opened which
> accepts connections. The sentinel is called - with a newly
> created process - whenever a connections is accepted.
I see several problems with this approach:
- What is the process-name for the connections? The same as for the
server socket? All connections with the same name?
- How do you open a Unix server socket?
- It's possible to open Unix server sockets. It would be reasonable
to support Unix client sockets too. How can this be done?
- What should NON-BLOCKING mean for server sockets?
- open-network-stream takes already 7 arguments. Putting even more
functionality in makes it hard to document.
Server sockets are IMHO different enough to merit a separate
function. What is the advantage of merging those concepts?
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-03-02 7:59 ` Non-blocking open-network-stream Helmut Eller
@ 2002-03-03 0:12 ` Kim F. Storm
2002-03-03 10:46 ` Helmut Eller
2002-03-03 16:44 ` Mario Lang
2002-03-03 14:39 ` Richard Stallman
1 sibling, 2 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-03-03 0:12 UTC (permalink / raw)
Cc: emacs-devel
Helmut Eller <helmut@xaital.km4u.net> writes:
> storm@cua.dk (Kim F. Storm) writes:
>
> > (do we have papers for that?)
>
> No. If needed, I will sign papers.
>
> > However, I think it can be done via open-network-stream:
> >
> > If the HOST argument is nil, a server socket is opened which
> > accepts connections. The sentinel is called - with a newly
> > created process - whenever a connections is accepted.
>
> I see several problems with this approach:
>
> - What is the process-name for the connections? The same as for the
> server socket? All connections with the same name?
My idea is to name it as the server process concatenated with the
ip address and source port of the client, i.e. something like
"service <10.20.30.40:3248>"
I prefer this to manually having to give each connection a unique name
in advance (as would be necessary with your accept-connection API).
>
> - How do you open a Unix server socket?
>
I intent do rename the NON-BLOCKING argument to a more generic TYPE
argument. Eventually, it could be things like:
If HOST specified - connect to that host:
nil - blocking connect (tcp) to SERVICE on HOST
t - non-blocking connect (tcp) to SERVICE on HOST
udp - open udp socket with target SERVICE on HOST
unix - connect to unix socket on address SERVICE
If HOST is nil - open a server socket:
nil - open tcp socket listning on SERVICE port
t - same as nil
udp - open udp socket bound to SERVICE port
unix - open unix socket bound to address SERVICE
> - It's possible to open Unix server sockets. It would be reasonable
> to support Unix client sockets too. How can this be done?
>
See above. (IIRC, Your patch didn't cover unix sockets)
> - What should NON-BLOCKING mean for server sockets?
See above.
>
> - open-network-stream takes already 7 arguments. Putting even more
> functionality in makes it hard to document.
I don't agree. Renaming NON-BLOCKING to TYPE and switching on
whether HOST is non-nil (connect) or nil (start server) seems
fairly clean and simple to me.
>
> Server sockets are IMHO different enough to merit a separate
> function. What is the advantage of merging those concepts?
>
Most of the necessary functionality is already in open-network-stream,
so adding the server part there is pretty orthogonal I think.
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-03-03 0:12 ` Kim F. Storm
@ 2002-03-03 10:46 ` Helmut Eller
2002-03-03 16:44 ` Mario Lang
1 sibling, 0 replies; 46+ messages in thread
From: Helmut Eller @ 2002-03-03 10:46 UTC (permalink / raw)
Cc: emacs-devel
storm@cua.dk (Kim F. Storm) writes:
> I intent do rename the NON-BLOCKING argument to a more generic TYPE
> argument. Eventually, it could be things like:
>
> If HOST specified - connect to that host:
>
> nil - blocking connect (tcp) to SERVICE on HOST
> t - non-blocking connect (tcp) to SERVICE on HOST
> udp - open udp socket with target SERVICE on HOST
> unix - connect to unix socket on address SERVICE
>
> If HOST is nil - open a server socket:
>
> nil - open tcp socket listning on SERVICE port
> t - same as nil
> udp - open udp socket bound to SERVICE port
> unix - open unix socket bound to address SERVICE
If you overload NON-BLOCKING in this way, you lose the ability to make
a non-blocking connects to Unix sockets. The distinction between INET
or Unix sockets should be made with an optional PROTOCOL-FAMILY
argument.
Also, mixing up UDP with Unix sockets is not a good idea. The main
difference between TCP and UPD is that UDP is packet oriented and TCP
is stream oriented. You can also have packet oriented Unix sockets.
Packet or stream orientedness should probably be specified with a
separate STYLE argument.
> See above. (IIRC, Your patch didn't cover unix sockets)
I added Unix sockets when RMS said that Unix sockets are required to
replace emacsserver.
> > - open-network-stream takes already 7 arguments. Putting even more
> > functionality in makes it hard to document.
>
> I don't agree. Renaming NON-BLOCKING to TYPE and switching on
> whether HOST is non-nil (connect) or nil (start server) seems
> fairly clean and simple to me.
I cannot help, but your TYPE argument looks like a kludge to me.
The HOST, BUFFER, and NON-BLOCKING arguments are not even used for
server sockets.
> > Server sockets are IMHO different enough to merit a separate
> > function. What is the advantage of merging those concepts?
> >
>
> Most of the necessary functionality is already in open-network-stream,
> so adding the server part there is pretty orthogonal I think.
I think there is not much shared functionality. open-network-stream
does basically this:
gethostbyname/socket/connect/coding-system-magic
For the server socket case it should do:
socket/bind/listen
Only the call to socket could be shared.
Below is my updated patch that supports Unix sockets. Perhaps you can
reuse some parts.
Index: process.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/process.c,v
retrieving revision 1.353
diff -c -r1.353 process.c
*** process.c 28 Feb 2002 23:59:19 -0000 1.353
--- process.c 3 Mar 2002 10:36:17 -0000
***************
*** 51,59 ****
--- 51,69 ----
#ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
#include <sys/socket.h>
+ #include <sys/un.h>
#include <netdb.h>
#include <netinet/in.h>
#include <arpa/inet.h>
+
+ /* Union of all socket address types we support. */
+ union sockaddr_union
+ {
+ struct sockaddr sa;
+ struct sockaddr_in sin;
+ struct sockaddr_un sun;
+ };
+
#ifdef NEED_NET_ERRNO_H
#include <net/errno.h>
#endif /* NEED_NET_ERRNO_H */
***************
*** 114,119 ****
--- 124,130 ----
Lisp_Object Qprocessp;
Lisp_Object Qrun, Qstop, Qsignal;
Lisp_Object Qopen, Qclosed, Qconnect, Qfailed;
+ Lisp_Object Qserver_socket, Qlisten, Qinet, Qunix;
Lisp_Object Qlast_nonmenu_event;
/* Qexit is declared and initialized in eval.c. */
***************
*** 122,129 ****
--- 133,142 ----
#ifdef HAVE_SOCKETS
#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
+ #define SERVER_SOCKET_P(p) ((XPROCESS (p)->childp) == Qserver_socket)
#else
#define NETCONN_P(p) 0
+ #define SERVER_SOCKET_P(p) 0
#endif /* HAVE_SOCKETS */
/* Define first descriptor number available for subprocesses. */
***************
*** 258,264 ****
static struct coding_system *proc_encode_coding_system[MAXDESC];
static Lisp_Object get_process ();
! static void exec_sentinel ();
extern EMACS_TIME timer_check ();
extern int timers_run;
--- 271,282 ----
static struct coding_system *proc_encode_coding_system[MAXDESC];
static Lisp_Object get_process ();
! static void exec_sentinel (Lisp_Object proc, Lisp_Object reason);
! static Lisp_Object read_process_output_error_handler (Lisp_Object error);
! static Lisp_Object read_process_output_call (Lisp_Object fun_and_args);
! #ifdef HAVE_SOCKETS
! static Lisp_Object decode_sockaddr_union (union sockaddr_union *u);
! #endif
extern EMACS_TIME timer_check ();
extern int timers_run;
***************
*** 614,619 ****
--- 632,642 ----
XPROCESS (process)->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
XSETINT (XPROCESS (process)->tick, ++process_tick);
}
+ else if (SERVER_SOCKET_P (process))
+ {
+ XPROCESS (process)->status = list2 (Qexit, make_number (0));
+ XSETINT (XPROCESS (process)->tick, ++process_tick);
+ }
else if (XINT (XPROCESS (process)->infd) >= 0)
{
Fkill_process (process, Qnil);
***************
*** 638,643 ****
--- 661,667 ----
closed -- for a network stream connection that is closed.
connect -- when waiting for a non-blocking connection to complete.
failed -- when a non-blocking connection has failed.
+ listen -- for a server socket that is listening.
nil -- if arg is a process name and no such process exists.
PROCESS may be a process, a buffer, the name of a process, or
nil, indicating the current buffer's process. */)
***************
*** 668,673 ****
--- 692,706 ----
else if (EQ (status, Qexit))
status = Qclosed;
}
+ else if (SERVER_SOCKET_P (process))
+ {
+ if (EQ (status, Qrun))
+ status = Qlisten;
+ else if (EQ (status, Qexit))
+ status = Qclosed;
+ else
+ abort ();
+ }
return status;
}
***************
*** 919,930 ****
DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1, 1, 0,
doc: /* Return the contact info of PROCESS; t for a real child.
! For a net connection, the value is a cons cell of the form (HOST SERVICE). */)
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
! return XPROCESS (process)->childp;
}
#if 0 /* Turned off because we don't currently record this info
--- 952,974 ----
DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1, 1, 0,
doc: /* Return the contact info of PROCESS; t for a real child.
! For a net connection, the value is a cons cell of the form (HOST SERVICE).
! For a server socket a cons cell of the form (server-socket . ADDRESS). */)
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
! #ifdef HAVE_SOCKETS
! if (SERVER_SOCKET_P (process))
! {
! union sockaddr_union u;
! socklen_t length = sizeof u;
! getsockname (XPROCESS (process)->infd, &u.sa, &length);
! return Fcons (Qserver_socket, decode_sockaddr_union (&u));
! }
! else
! #endif
! return XPROCESS (process)->childp;
}
#if 0 /* Turned off because we don't currently record this info
***************
*** 998,1003 ****
--- 1042,1056 ----
else
Fprinc (symbol, Qnil);
}
+ else if (SERVER_SOCKET_P (proc))
+ {
+ if (EQ (symbol, Qrun))
+ write_string ("listen", -1);
+ else if (EQ (symbol, Qexit))
+ write_string ("closed", -1);
+ else
+ Fprinc (symbol, Qnil);
+ }
else
Fprinc (symbol, Qnil);
***************
*** 1038,1043 ****
--- 1091,1115 ----
XSTRING (XCAR (p->childp))->data);
insert_string (tembuf);
}
+ else if (SERVER_SOCKET_P (proc))
+ {
+ union sockaddr_union u;
+ socklen_t length = sizeof u;
+ getsockname (p->infd, &u.sa, &length);
+ switch (u.sa.sa_family)
+ {
+ case AF_INET:
+ sprintf (tembuf, "(inet socket on port %d)\n",
+ ntohs (u.sin.sin_port));
+ break;
+ case AF_LOCAL:
+ sprintf (tembuf, "(unix socket %s)\n", u.sun.sun_path);
+ break;
+ default:
+ abort ();
+ }
+ insert_string (tembuf);
+ }
else
{
tem = p->command;
***************
*** 1778,1783 ****
--- 1850,1986 ----
#ifdef HAVE_SOCKETS
+ /* Setup coding systems for communicating with the network stream. */
+ static void
+ select_coding_system (proc)
+ Lisp_Object proc;
+ {
+ Lisp_Object buffer = XPROCESS (proc)->buffer;
+ Lisp_Object name = XPROCESS (proc)->name;
+ Lisp_Object host = XCAR (XPROCESS (proc)->childp);
+ Lisp_Object service = XCAR (XCDR (XPROCESS (proc)->childp));
+ int inch = XINT (XPROCESS (proc)->infd);
+ int outch = XINT (XPROCESS (proc)->outfd);
+ {
+ struct gcpro gcpro1;
+ /* Qt denotes we have not yet called Ffind_operation_coding_system. */
+ Lisp_Object coding_systems = Qt;
+ Lisp_Object args[5], val;
+
+ if (!NILP (Vcoding_system_for_read))
+ val = Vcoding_system_for_read;
+ else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
+ || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
+ /* We dare not decode end-of-line format by setting VAL to
+ Qraw_text, because the existing Emacs Lisp libraries
+ assume that they receive bare code including a sequene of
+ CR LF. */
+ val = Qnil;
+ else
+ {
+ args[0] = Qopen_network_stream, args[1] = name,
+ args[2] = buffer, args[3] = host, args[4] = service;
+ GCPRO1 (proc);
+ coding_systems = Ffind_operation_coding_system (5, args);
+ UNGCPRO;
+ if (CONSP (coding_systems))
+ val = XCAR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCAR (Vdefault_process_coding_system);
+ else
+ val = Qnil;
+ }
+ XPROCESS (proc)->decode_coding_system = val;
+
+ if (!NILP (Vcoding_system_for_write))
+ val = Vcoding_system_for_write;
+ else if (NILP (current_buffer->enable_multibyte_characters))
+ val = Qnil;
+ else
+ {
+ if (EQ (coding_systems, Qt))
+ {
+ args[0] = Qopen_network_stream, args[1] = name,
+ args[2] = buffer, args[3] = host, args[4] = service;
+ GCPRO1 (proc);
+ coding_systems = Ffind_operation_coding_system (5, args);
+ UNGCPRO;
+ }
+ if (CONSP (coding_systems))
+ val = XCDR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCDR (Vdefault_process_coding_system);
+ else
+ val = Qnil;
+ }
+ XPROCESS (proc)->encode_coding_system = val;
+ }
+
+ if (!proc_decode_coding_system[inch])
+ proc_decode_coding_system[inch]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ setup_coding_system (XPROCESS (proc)->decode_coding_system,
+ proc_decode_coding_system[inch]);
+ if (!proc_encode_coding_system[outch])
+ proc_encode_coding_system[outch]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ setup_coding_system (XPROCESS (proc)->encode_coding_system,
+ proc_encode_coding_system[outch]);
+
+ XPROCESS (proc)->decoding_buf = make_uninit_string (0);
+ XPROCESS (proc)->decoding_carryover = make_number (0);
+ XPROCESS (proc)->encoding_buf = make_uninit_string (0);
+ XPROCESS (proc)->encoding_carryover = make_number (0);
+
+ XPROCESS (proc)->inherit_coding_system_flag
+ = (NILP (buffer) || !inherit_process_coding_system
+ ? Qnil : Qt);
+
+ }
+
+ /* create and initialize a process representing a socket. */
+ static Lisp_Object
+ make_socket_process (fd, name, childp, status, buffer)
+ int fd;
+ Lisp_Object name, childp, status, buffer;
+ {
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ GCPRO4 (name, childp, status, buffer);
+ {
+ Lisp_Object proc = make_process (name);
+ chan_process[fd] = proc;
+ XPROCESS (proc)->childp = childp;
+ XPROCESS (proc)->command_channel_p = Qnil;
+ XPROCESS (proc)->buffer = buffer;
+ XPROCESS (proc)->sentinel = Qnil;
+ XPROCESS (proc)->filter = Qnil;
+ XPROCESS (proc)->command = Qnil;
+ XPROCESS (proc)->pid = Qnil;
+ XSETINT (XPROCESS (proc)->infd, fd);
+ XSETINT (XPROCESS (proc)->outfd, fd);
+ XPROCESS (proc)->status = status;
+ if (fd > max_process_desc)
+ max_process_desc = fd;
+ return proc;
+ }
+ }
+
+ /* Make FD non-blocking and add it to the input fd-sets. */
+ static void
+ register_fd_for_input (fd)
+ int fd;
+ {
+ #ifdef O_NONBLOCK
+ fcntl (fd, F_SETFL, O_NONBLOCK);
+ #else
+ #ifdef O_NDELAY
+ fcntl (fd, F_SETFL, O_NDELAY);
+ #endif
+ #endif
+ FD_SET (fd, &input_wait_mask);
+ FD_SET (fd, &non_keyboard_wait_mask);
+ }
+
/* open a TCP network connection to a given HOST/SERVICE. Treated
exactly like a normal process when reading and writing. Only
differences are in status display and process deletion. A network
***************
*** 1836,1842 ****
#endif /* HAVE_GETADDRINFO */
int ret = 0;
int xerrno = 0;
! int s = -1, outch, inch;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
int retry = 0;
int count = specpdl_ptr - specpdl;
--- 2039,2045 ----
#endif /* HAVE_GETADDRINFO */
int ret = 0;
int xerrno = 0;
! int s = -1;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
int retry = 0;
int count = specpdl_ptr - specpdl;
***************
*** 2135,2167 ****
send_command (s, C_DUMB, 1, 0);
#endif /* TERM */
- inch = s;
- outch = s;
-
if (!NILP (buffer))
buffer = Fget_buffer_create (buffer);
- proc = make_process (name);
-
- chan_process[inch] = proc;
-
- #ifdef O_NONBLOCK
- fcntl (inch, F_SETFL, O_NONBLOCK);
- #else
- #ifdef O_NDELAY
- fcntl (inch, F_SETFL, O_NDELAY);
- #endif
- #endif
! XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
! XPROCESS (proc)->command_channel_p = Qnil;
! XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = XCAR (sentinel);
XPROCESS (proc)->filter = XCDR (sentinel);
- XPROCESS (proc)->command = Qnil;
- XPROCESS (proc)->pid = Qnil;
- XSETINT (XPROCESS (proc)->infd, inch);
- XSETINT (XPROCESS (proc)->outfd, outch);
- XPROCESS (proc)->status = Qrun;
#ifdef NON_BLOCKING_CONNECT
if (!NILP (non_blocking))
--- 2338,2349 ----
send_command (s, C_DUMB, 1, 0);
#endif /* TERM */
if (!NILP (buffer))
buffer = Fget_buffer_create (buffer);
! proc = make_socket_process (s, name, list2 (host, service), Qrun, buffer);
XPROCESS (proc)->sentinel = XCAR (sentinel);
XPROCESS (proc)->filter = XCDR (sentinel);
#ifdef NON_BLOCKING_CONNECT
if (!NILP (non_blocking))
***************
*** 2170,2271 ****
in that case, we still need to signal this like a non-blocking
connection. */
XPROCESS (proc)->status = Qconnect;
! if (!FD_ISSET (inch, &connect_wait_mask))
! {
! FD_SET (inch, &connect_wait_mask);
num_pending_connects++;
}
}
else
#endif
! if (!EQ (XPROCESS (proc)->filter, Qt))
{
! FD_SET (inch, &input_wait_mask);
! FD_SET (inch, &non_keyboard_wait_mask);
}
! if (inch > max_process_desc)
! max_process_desc = inch;
{
! /* Setup coding systems for communicating with the network stream. */
! struct gcpro gcpro1;
! /* Qt denotes we have not yet called Ffind_operation_coding_system. */
! Lisp_Object coding_systems = Qt;
! Lisp_Object args[5], val;
! if (!NILP (Vcoding_system_for_read))
! val = Vcoding_system_for_read;
! else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
! || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
! /* We dare not decode end-of-line format by setting VAL to
! Qraw_text, because the existing Emacs Lisp libraries
! assume that they receive bare code including a sequene of
! CR LF. */
! val = Qnil;
! else
! {
! args[0] = Qopen_network_stream, args[1] = name,
! args[2] = buffer, args[3] = host, args[4] = service;
! GCPRO1 (proc);
! coding_systems = Ffind_operation_coding_system (5, args);
! UNGCPRO;
! if (CONSP (coding_systems))
! val = XCAR (coding_systems);
! else if (CONSP (Vdefault_process_coding_system))
! val = XCAR (Vdefault_process_coding_system);
! else
! val = Qnil;
! }
! XPROCESS (proc)->decode_coding_system = val;
! if (!NILP (Vcoding_system_for_write))
! val = Vcoding_system_for_write;
! else if (NILP (current_buffer->enable_multibyte_characters))
! val = Qnil;
! else
{
! if (EQ (coding_systems, Qt))
{
! args[0] = Qopen_network_stream, args[1] = name,
! args[2] = buffer, args[3] = host, args[4] = service;
! GCPRO1 (proc);
! coding_systems = Ffind_operation_coding_system (5, args);
! UNGCPRO;
}
- if (CONSP (coding_systems))
- val = XCDR (coding_systems);
- else if (CONSP (Vdefault_process_coding_system))
- val = XCDR (Vdefault_process_coding_system);
- else
- val = Qnil;
}
! XPROCESS (proc)->encode_coding_system = val;
! }
!
! if (!proc_decode_coding_system[inch])
! proc_decode_coding_system[inch]
! = (struct coding_system *) xmalloc (sizeof (struct coding_system));
! setup_coding_system (XPROCESS (proc)->decode_coding_system,
! proc_decode_coding_system[inch]);
! if (!proc_encode_coding_system[outch])
! proc_encode_coding_system[outch]
! = (struct coding_system *) xmalloc (sizeof (struct coding_system));
! setup_coding_system (XPROCESS (proc)->encode_coding_system,
! proc_encode_coding_system[outch]);
!
! XPROCESS (proc)->decoding_buf = make_uninit_string (0);
! XPROCESS (proc)->decoding_carryover = make_number (0);
! XPROCESS (proc)->encoding_buf = make_uninit_string (0);
! XPROCESS (proc)->encoding_carryover = make_number (0);
!
! XPROCESS (proc)->inherit_coding_system_flag
! = (NILP (buffer) || !inherit_process_coding_system
! ? Qnil : Qt);
!
! UNGCPRO;
! return proc;
}
#endif /* HAVE_SOCKETS */
void
--- 2352,2618 ----
in that case, we still need to signal this like a non-blocking
connection. */
XPROCESS (proc)->status = Qconnect;
! if (!FD_ISSET (s, &connect_wait_mask))
! {
! FD_SET (s, &connect_wait_mask);
num_pending_connects++;
}
}
else
#endif
! register_fd_for_input (s);
!
! select_coding_system (proc);
!
! UNGCPRO;
! return proc;
! }
!
! #define BACKLOG 5
!
! /* Open a listening socket on PORT and return the socket descriptor. */
! static int
! open_inet_socket (int port)
! {
! int fd = socket (PF_INET, SOCK_STREAM, 0);
! if (fd <= 0) goto error;
! {
! int err;
! int optval = 1;
! struct sockaddr_in servaddr;
! bzero (&servaddr, sizeof servaddr);
! servaddr.sin_family = AF_INET;
! servaddr.sin_port = htons (port);
! servaddr.sin_addr.s_addr = htonl (INADDR_ANY);
! err = setsockopt (fd, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval);
! if (err != 0) goto error;
! err = bind (fd, (struct sockaddr *)&servaddr, sizeof servaddr);
! if (err != 0) goto error;
! err = listen (fd, BACKLOG);
! if (err != 0) goto error;
! return fd;
! }
! error:
! if (fd > 0)
! close (fd);
! report_file_error ("open-server-socket", Qnil);
! abort ();
! }
!
! static int
! open_unix_socket (char *filename)
! {
! int fd = socket (PF_LOCAL, SOCK_STREAM, 0);
! if (fd <= 0) goto error;
! {
! int err;
! struct sockaddr_un servaddr;
! bzero (&servaddr, sizeof servaddr);
! servaddr.sun_family = AF_LOCAL;
! strncpy (servaddr.sun_path, filename, sizeof servaddr.sun_path);
! err = bind (fd, (struct sockaddr *)&servaddr, sizeof servaddr);
! if (err != 0) goto error;
! err = listen (fd, BACKLOG);
! if (err != 0) goto error;
! return fd;
! }
! error:
! if (fd > 0)
! close (fd);
! report_file_error ("open-server-socket", Qnil);
! abort ();
! }
!
! /* Open a server socket on a given port. The filter function must be
! set before accepting connections with `accept-connection'. The
! process-buffer is not used. */
!
! DEFUN ("open-server-socket", Fopen_server_socket, Sopen_server_socket,
! 3, 3, 0,
! doc: /* Open a server socket on a port.
!
! Returns a process object to represent the socket. The filter function
! can be used to accept connections. See `accept-connection'.
! `delete-process' closes the server socket.
!
! NAME is the name for the process.
! PROTOCOL either 'inet or 'unix.
! PORT is the port number resp. filename for the socket. */ )
! (name, protocol, port)
! Lisp_Object name, protocol, port;
! {
! int fd;
! CHECK_STRING (name);
! CHECK_SYMBOL (protocol);
! if (protocol == Qinet)
! {
! CHECK_NATNUM (port);
! if ((XINT (port) < 0) || ((1 << 16) <= XINT (port)))
! error ("Port number out of range");
! fd = open_inet_socket (XINT (port));
! }
! else if (protocol == Qunix)
! {
! CHECK_STRING (port);
! fd = open_unix_socket (XSTRING (port)->data);
! }
! else
! error ("Unsupported protocol %s", XSYMBOL (protocol)->name->data);
! return make_socket_process (fd, name, Qserver_socket, Qrun, Qnil);
! }
!
! /* return a Lisp representation for U:
! (HOST PORT) for AF_INET
! (unix FILENAME) for AF_UNIX. */
! static Lisp_Object
! decode_sockaddr_union (union sockaddr_union *u)
! {
! switch (u->sa.sa_family)
! {
! case AF_INET:
{
! char string[INET_ADDRSTRLEN];
! inet_ntop (AF_INET, &u->sin.sin_addr, string, sizeof string);
! return list2 (build_string (string),
! make_number (ntohs (u->sin.sin_port)));
}
+ case AF_LOCAL:
+ return list2 (Qunix, build_string (u->sun.sun_path));
+ default:
+ abort ();
+ }
+ }
+
+ /* Accept a connection on SERVER_SOCKET. Remove SERVER_SOCKET from
+ the input fd-set so that only the first waiting client is accepted.
+ Then create a process representing the new connection and pass it
+ to PROCESS's filter function. */
+ static void
+ accept_client (process, server_socket)
+ Lisp_Object process;
+ int server_socket;
+ {
+ struct gcpro gcpro1, gcpro2;
+ union sockaddr_union u;
+ socklen_t length = sizeof u;
+ int fd = accept (server_socket, (struct sockaddr*)&u, &length);
+ FD_CLR (server_socket, &input_wait_mask);
+ FD_CLR (server_socket, &non_keyboard_wait_mask);
+ if (fd == -1)
+ {
+ if (NILP (XPROCESS (process)->sentinel))
+ report_file_error ("accept", process);
+ else
+ exec_sentinel (process, build_string (emacs_strerror (errno)));
+ }
+ else
+ {
+ Lisp_Object childp = decode_sockaddr_union (&u);
+ Lisp_Object proc = make_socket_process (fd, XPROCESS (process)->mark,
+ childp, Qrun, Qnil);
+ GCPRO2 (process, proc);
+ select_coding_system (proc);
+ register_fd_for_input (fd);
+ internal_condition_case_1 (read_process_output_call,
+ list3 (XPROCESS (process)->filter,
+ process,
+ proc),
+ NILP (Vdebug_on_error) ? Qerror : Qnil,
+ read_process_output_error_handler);
+ UNGCPRO;
+ }
+ }
! DEFUN ("accept-connection", Faccept_connection, Saccept_connection,
! 2, 2, 0,
! doc: /* Accept a connection on the server socket.
+ This function is non-blocking and returns nil. The next incoming
+ connection will be accepted and passed to the process filter. The
+ process filter function receives 2 arguments: the server socket and a
+ process representing the new connection. The new process is treated
+ exactly like a network connection opened with `open-network-stream'.
+
+ PROCESS a process representing a server socket.
+ NAME is the name for the new connection. */ )
+ (process, name)
+ Lisp_Object process, name;
+ {
+ CHECK_PROCESS (process);
+ if (! (SERVER_SOCKET_P (process)))
+ error ("Process %s is not a server socket process",
+ XSTRING (XPROCESS (process)->name)->data);
+ CHECK_STRING (name);
{
! int fd = XINT (XPROCESS (process)->infd);
! XPROCESS (process)->mark = name; /* kludge: field is otherwise unused */
! register_fd_for_input (fd);
! return Qnil;
! }
! }
! DEFUN ("gethostbyname", Fgethostbyname, Sgethostbyname,
! 1, 1, 0,
! doc: /* Look up a host by name.
! Return the IP address and aliases for NAME. The result is a vector of
! this form: [hostent CANONICAL-NAME ALIASES ADDRTYPE ADDRLIST]
!
! CANONICAL-NAME is a string.
! ALIASES is a list of strings.
! ADDRTYPE is the symbol inet.
! ADDRLIST is a list of this form ((INT INT INT INT)* )
! each INT correspond to 1 byte of the 32 bit address. */)
! (name)
! Lisp_Object name;
! {
! int gcpro1;
! struct hostent *hostent;
! CHECK_STRING (name);
! hostent = gethostbyname (XSTRING (name)->data);
! if (hostent == 0)
! error ("%s", hstrerror (h_errno));
! else
! {
! Lisp_Object host_info = Fmake_vector (make_number (5), Qnil);
! Lisp_Object *vector = XVECTOR (host_info)->contents;
! GCPRO1 (host_info);
! vector[0] = intern ("hostent");
! vector[1] = build_string (hostent->h_name);
{
! char **p = hostent->h_aliases;
! while (*p != 0)
{
! vector[2] = Fcons (build_string (*p), vector[2]);
! p++;
}
}
! switch (hostent->h_addrtype)
! {
! case AF_INET:
! {
! struct in_addr **p = (struct in_addr **)hostent->h_addr_list;
! vector[3] = Qinet;
! while (*p != 0)
! {
! uint32_t a = ntohl ((**p).s_addr);
! vector[4] = Fcons (list4 (make_number ((a >> 24) & 0xff),
! make_number ((a >> 16) & 0xff),
! make_number ((a >> 8) & 0xff),
! make_number ((a >> 0) & 0xff)),
! vector[4]);
! p++;
! }
! break;
! }
! default:
! abort ();
! }
! UNGCPRO;
! return host_info;
! }
}
+
#endif /* HAVE_SOCKETS */
void
***************
*** 2911,2916 ****
--- 3258,3268 ----
proc = chan_process[channel];
if (NILP (proc))
continue;
+ if (SERVER_SOCKET_P (proc))
+ {
+ accept_client (proc, channel);
+ continue;
+ }
/* Read data from the process, starting with our
buffered-ahead character if we have one. */
***************
*** 3469,3474 ****
--- 3821,3828 ----
if (XINT (XPROCESS (proc)->outfd) < 0)
error ("Output file descriptor of %s is closed",
XSTRING (XPROCESS (proc)->name)->data);
+ if (SERVER_SOCKET_P (proc))
+ error ("Cannot write to server socket");
coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
Vlast_coding_system_used = coding->symbol;
***************
*** 4246,4251 ****
--- 4600,4607 ----
update_status (XPROCESS (proc));
if (! EQ (XPROCESS (proc)->status, Qrun))
error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
+ if (SERVER_SOCKET_P (proc))
+ error ("Cannot write to server socket", XSTRING (XPROCESS (proc)->name));
if (CODING_REQUIRE_FLUSHING (coding))
{
***************
*** 4311,4316 ****
--- 4667,4674 ----
{
if (NETCONN_P (proc))
Fdelete_process (proc);
+ else if (SERVER_SOCKET_P (proc))
+ Fdelete_process (proc);
else if (XINT (XPROCESS (proc)->infd) >= 0)
process_send_signal (proc, SIGHUP, Qnil, 1);
}
***************
*** 4861,4866 ****
--- 5219,5234 ----
Qfailed = intern ("failed");
staticpro (&Qfailed);
+ Qlisten = intern ("listen");
+ staticpro (&Qlisten);
+
+ Qserver_socket = intern ("server-socket");
+ staticpro (&Qserver_socket);
+ Qinet = intern ("inet");
+ staticpro (&Qinet);
+ Qunix = intern ("unix");
+ staticpro (&Qunix);
+
Qlast_nonmenu_event = intern ("last-nonmenu-event");
staticpro (&Qlast_nonmenu_event);
***************
*** 4907,4912 ****
--- 5275,5283 ----
defsubr (&Sstart_process);
#ifdef HAVE_SOCKETS
defsubr (&Sopen_network_stream);
+ defsubr (&Sopen_server_socket);
+ defsubr (&Saccept_connection);
+ defsubr (&Sgethostbyname);
#endif /* HAVE_SOCKETS */
defsubr (&Saccept_process_output);
defsubr (&Sprocess_send_region);
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-03-02 7:59 ` Non-blocking open-network-stream Helmut Eller
2002-03-03 0:12 ` Kim F. Storm
@ 2002-03-03 14:39 ` Richard Stallman
1 sibling, 0 replies; 46+ messages in thread
From: Richard Stallman @ 2002-03-03 14:39 UTC (permalink / raw)
Cc: storm, emacs-devel
Server sockets are IMHO different enough to merit a separate
function. What is the advantage of merging those concepts?
A priori it is a simplification to merge them. But if merging them is
painful in the details, then we are better off not merging them.
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Non-blocking open-network-stream
2002-03-03 0:12 ` Kim F. Storm
2002-03-03 10:46 ` Helmut Eller
@ 2002-03-03 16:44 ` Mario Lang
1 sibling, 0 replies; 46+ messages in thread
From: Mario Lang @ 2002-03-03 16:44 UTC (permalink / raw)
storm@cua.dk (Kim F. Storm) writes:
> I intent do rename the NON-BLOCKING argument to a more generic TYPE
> argument. Eventually, it could be things like:
>
> If HOST specified - connect to that host:
>
> nil - blocking connect (tcp) to SERVICE on HOST
> t - non-blocking connect (tcp) to SERVICE on HOST
> udp - open udp socket with target SERVICE on HOST
> unix - connect to unix socket on address SERVICE
>
> If HOST is nil - open a server socket:
>
> nil - open tcp socket listning on SERVICE port
> t - same as nil
> udp - open udp socket bound to SERVICE port
> unix - open unix socket bound to address SERVICE
Isn't this quite limiting? What comes into mind first is that binding a
server socket to a specific interface is not possible then.
Also, as I discussed privately with Helmut, it should be possible to specify
either 0 or nil (not sure) for the PORT to be able to assign a
arbitrary free port (dynamic server socket for e.g. DCC).
I didn't look very closely at both approaches yet, but it seems to me
from first impression that merging non-blocking connects and server sockets
into one single function is quite messy.
--
CYa,
Mario <mlang@delysid.org>
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* New patch for server sockets and datagram (UDP) support.
2002-03-01 21:23 ` Richard Stallman
@ 2002-03-07 0:08 ` Kim F. Storm
2002-03-07 10:56 ` Kim F. Storm
` (2 more replies)
0 siblings, 3 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-03-07 0:08 UTC (permalink / raw)
Cc: helmut
Richard Stallman <rms@gnu.org> writes:
> If the HOST argument is nil, a server socket is opened which
> accepts connections. The sentinel is called - with a newly
> created process - whenever a connections is accepted.
>
> That sounds good to me in principle, if the details work ok.
The following patch adds server socket support via open-network-stream.
If the HOST is nil, a server socket for SERVICE is opened in listening
state.
When a connection is accepted, a new process is created with a
name (and buffer) named according to the original process combined
with the caller's address, e.g. if the server process is named "p1",
the new process will be called something like "p1 <1.2.3.4:928>"
Likewise for the buffer.
I have removed the NON-BLOCKING argument, and instead added a new TYPE
argument, which specifies the type of connection (blocking connect,
non-blocking connect, or datagram), and may optionally specify the
address family (inet or local [aka. unix]).
To open a TCP server socket for "telnet", where client
processes have no buffer, do
(open-network-stream "telnetd" nil nil "telnet" nil
telnetd-filter telnetd-sentinel)
To open a UDP (datagram) server socket for "dns", do
(open-network-stream "dns" nil nil "dns" 'datagram
dns-filter dns-sentinel)
Notice that datagram server sockets do not get separate processes for
each caller. Instead, there is a new `process-datagram-address'
function to get (and set) the client address for the next
process-send-... call.
To open a LOCAL (UNIX) server socket for "/tmp/xyz", where
client processes do have a buffer, do
(open-network-stream "xyz" "XYZ" nil "/tmp/xyz" (local)
xyz-filter xyz-sentinel)
To connect to each of these services, simply specify the hostname
instead of nil as the third argument.
See also the documentation for the variable `network-server-log-function'.
To get a log of accept calls, the following setting can be used:
(defun logf (s p m)
(if (process-buffer s)
(with-current-buffer (process-buffer s)
(insert (process-name s) ">>" m))))
(setq network-server-log-function 'logf))
I have tried to make the additions fail-safe by conditioning on
AF_LOCAL (or AF_UNIX), and a new DATAGRAM_SOCKETS define.
The latter requires that sendto and recvfrom are added to
the functions detected by configure.
If datagrams are not supported, open-network-stream will return nil
when requesting a datagram connection.
Index: process.c
===================================================================
RCS file: /cvs/emacs/src/process.c,v
retrieving revision 1.355
diff -c -r1.355 process.c
*** process.c 3 Mar 2002 00:31:22 -0000 1.355
--- process.c 6 Mar 2002 23:40:07 -0000
***************
*** 54,59 ****
--- 54,67 ----
#include <netdb.h>
#include <netinet/in.h>
#include <arpa/inet.h>
+ #ifndef AF_LOCAL
+ #ifdef AF_UNIX
+ #define AF_LOCAL AF_UNIX
+ #endif
+ #endif
+ #ifdef AF_LOCAL
+ #include <sys/un.h>
+ #endif
#ifdef NEED_NET_ERRNO_H
#include <net/errno.h>
#endif /* NEED_NET_ERRNO_H */
***************
*** 113,119 ****
Lisp_Object Qprocessp;
Lisp_Object Qrun, Qstop, Qsignal;
! Lisp_Object Qopen, Qclosed, Qconnect, Qfailed;
Lisp_Object Qlast_nonmenu_event;
/* Qexit is declared and initialized in eval.c. */
--- 121,128 ----
Lisp_Object Qprocessp;
Lisp_Object Qrun, Qstop, Qsignal;
! Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
! Lisp_Object Qlocal, Qdatagram;
Lisp_Object Qlast_nonmenu_event;
/* Qexit is declared and initialized in eval.c. */
***************
*** 198,203 ****
--- 207,235 ----
#undef NON_BLOCKING_CONNECT
#endif
+ /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
+ this system. We need to read full packets, so we need a
+ "non-destructive" select. So we require either native select,
+ or emulation of select using FIONREAD. */
+
+ #ifdef GNU_LINUX
+ #define DATAGRAM_SOCKETS
+ #endif
+
+ #ifdef BROKEN_DATAGRAM_SOCKETS
+ #undef DATAGRAM_SOCKETS
+ #else
+ #ifndef DATAGRAM_SOCKETS
+ #ifdef HAVE_SOCKETS
+ #if defined (HAVE_SELECT) || defined (FIONREAD)
+ #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
+ #define DATAGRAM_SOCKETS
+ #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
+ #endif /* HAVE_SELECT || FIONREAD */
+ #endif /* HAVE_SOCKETS */
+ #endif /* DATAGRAM_SOCKETS */
+ #endif /* BROKEN_DATAGRAM_SOCKETS */
+
#include "sysselect.h"
extern int keyboard_bit_set P_ ((SELECT_TYPE *));
***************
*** 257,262 ****
--- 289,310 ----
static struct coding_system *proc_decode_coding_system[MAXDESC];
static struct coding_system *proc_encode_coding_system[MAXDESC];
+ #ifdef DATAGRAM_SOCKETS
+ /* Table of `client address' for datagram sockets. */
+ struct sockaddr_and_len {
+ struct sockaddr *sa;
+ int len;
+ } datagram_address[MAXDESC];
+ #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
+ #define DATAGRAM_CONN_P(proc) (datagram_address[XPROCESS (proc)->infd].sa != 0)
+ #else
+ #define DATAGRAM_CHAN_P(chan) (0)
+ #define DATAGRAM_CONN_P(proc) (0)
+ #endif
+
+ /* Hook function to call when accepting network connection. */
+ Lisp_Object Vnetwork_server_log_function;
+
static Lisp_Object get_process ();
static void exec_sentinel ();
***************
*** 367,381 ****
return build_string ("finished\n");
string = Fnumber_to_string (make_number (code));
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
! return concat2 (build_string ("exited abnormally with code "),
! concat2 (string, string2));
}
else if (EQ (symbol, Qfailed))
{
string = Fnumber_to_string (make_number (code));
string2 = build_string ("\n");
! return concat2 (build_string ("failed with code "),
! concat2 (string, string2));
}
else
return Fcopy_sequence (Fsymbol_name (symbol));
--- 415,429 ----
return build_string ("finished\n");
string = Fnumber_to_string (make_number (code));
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
! return concat3 (build_string ("exited abnormally with code "),
! string, string2);
}
else if (EQ (symbol, Qfailed))
{
string = Fnumber_to_string (make_number (code));
string2 = build_string ("\n");
! return concat3 (build_string ("failed with code "),
! string, string2);
}
else
return Fcopy_sequence (Fsymbol_name (symbol));
***************
*** 946,952 ****
register Lisp_Object tail, tem;
Lisp_Object proc, minspace, tem1;
register struct Lisp_Process *p;
! char tembuf[80];
XSETFASTINT (minspace, 1);
--- 994,1000 ----
register Lisp_Object tail, tem;
Lisp_Object proc, minspace, tem1;
register struct Lisp_Process *p;
! char tembuf[300];
XSETFASTINT (minspace, 1);
***************
*** 1032,1041 ****
Findent_to (make_number (49), minspace);
! if (NETCONN_P (proc))
{
! sprintf (tembuf, "(network stream connection to %s)\n",
! XSTRING (XCAR (p->childp))->data);
insert_string (tembuf);
}
else
--- 1080,1109 ----
Findent_to (make_number (49), minspace);
! if (EQ (XPROCESS (proc)->status, Qlisten))
! {
! Lisp_Object port = XCAR (XCDR (p->childp));
! if (INTEGERP (port))
! port = Fnumber_to_string (port);
! sprintf (tembuf, "(network %s server on %s)\n",
! (DATAGRAM_CONN_P(proc) ? "datagram" : "stream"),
! XSTRING (port)->data);
! insert_string (tembuf);
! }
! else if (NETCONN_P (proc))
{
! /* For a local socket, there is no host name,
! so display service instead. */
! Lisp_Object host = XCAR (p->childp);
! if (!STRINGP (host))
! {
! host = XCAR (XCDR (p->childp));
! if (INTEGERP (host))
! host = Fnumber_to_string (host);
! }
! sprintf (tembuf, "(network %s connection to %s)\n",
! (DATAGRAM_CONN_P(proc) ? "datagram" : "stream"),
! XSTRING (host)->data);
insert_string (tembuf);
}
else
***************
*** 1793,1799 ****
normal connect instead.
Input and output work as for subprocesses; `delete-process' closes it.
! Args are NAME BUFFER HOST SERVICE FILTER SENTINEL NON-BLOCKING.
NAME is name for process. It is modified if necessary to make it unique.
BUFFER is the buffer (or buffer-name) to associate with the process.
Process output goes at end of that buffer, unless you specify
--- 1861,1867 ----
normal connect instead.
Input and output work as for subprocesses; `delete-process' closes it.
! Args are NAME BUFFER HOST SERVICE TYPE FILTER SENTINEL.
NAME is name for process. It is modified if necessary to make it unique.
BUFFER is the buffer (or buffer-name) to associate with the process.
Process output goes at end of that buffer, unless you specify
***************
*** 1801,1829 ****
BUFFER may be also nil, meaning that this process is not associated
with any buffer.
HOST is name of the host to connect to, or its IP address.
SERVICE is name of the service desired, or an integer specifying a
! port number to connect to.
FILTER and SENTINEL are optional args specifying the filter and
sentinel functions associated with the network stream.
! NON-BLOCKING is optional arg requesting an non-blocking connect.
! When non-nil, open-network-stream will return immediately without
! waiting for the connection to be made. Instead, the sentinel function
! will be called with second matching "open" (if successful) or
! "failed" when the connect completes. */)
! (name, buffer, host, service, filter, sentinel, non_blocking)
! Lisp_Object name, buffer, host, service, filter, sentinel, non_blocking;
{
Lisp_Object proc;
#ifdef HAVE_GETADDRINFO
! struct addrinfo hints, *res, *lres;
char *portstring, portbuf[128];
#else /* HAVE_GETADDRINFO */
- struct sockaddr_in address;
- struct servent *svc_info;
struct hostent *host_info_ptr, host_info;
char *(addr_list[2]);
IN_ADDR numeric_addr;
- int port;
struct _emacs_addrinfo
{
int ai_family;
--- 1869,1926 ----
BUFFER may be also nil, meaning that this process is not associated
with any buffer.
HOST is name of the host to connect to, or its IP address.
+ If the HOST arg is nil, a server socket is opened listening on the
+ specified service (see below).
SERVICE is name of the service desired, or an integer specifying a
! port number to connect to.
! The fifth optional arg specifies the type of connection being made.
! It is either a symbol TYPE, or a cons cell (FAMILY . TYPE).
! TYPE is one of the following symbols (default is nil):
! nil -- opens a stream connection; returns when connection is completed.
! t -- opens a non-blocking stream connection; returns immediately
! without waiting for the connection to complete. Instead, the
! sentinel function will be called with second matching "open"
! (if successful) or "failed" when the connect completes.
! datagram -- opens a connection-less datagram socket (typically UDP).
! FAMILY specifies the address family for the connection:
! nil -- Inet (IPv4) address family.
! local -- local (UNIX) address family.
FILTER and SENTINEL are optional args specifying the filter and
sentinel functions associated with the network stream.
!
! When the HOST is nil, a server process for the specified SERVICE and
! TYPE is created. The server process will listen for and accept
! connections from clients. When a client connection is accepted, a new
! network process is created for the connection with the following
! parameters:
! The client's process name is constructed by concatenating the server
! process' NAME and a client identification string.
! If the FILTER argument is non-nil, the client process will not get a
! separate process buffer; otherwise, the client's process buffer is a
! newly created buffer named after the server process' BUFFER name or
! process NAME concatenated with the client identification string.
! The client process' contact info is set according to the client's
! addressing information (typically an IP address and a port number).
! The connection type and the process filter and sentinel parameters
! are inherited from the server process' TYPE, FILTER and SENTINEL.
!
! Notice that the FILTER and SENTINEL args are never used directly by
! the server process. Also, the BUFFER argument is not used directly by
! the server process, but via `network-server-log-function' hook, a log
! of the accepted (and failed) connections may be recorded in the server
! process' buffer. */)
! (name, buffer, host, service, type, filter, sentinel)
! Lisp_Object name, buffer, host, service, type, filter, sentinel;
{
Lisp_Object proc;
+ Lisp_Object contact;
#ifdef HAVE_GETADDRINFO
! struct addrinfo ai, hints, *res, *lres;
char *portstring, portbuf[128];
#else /* HAVE_GETADDRINFO */
struct hostent *host_info_ptr, host_info;
char *(addr_list[2]);
IN_ADDR numeric_addr;
struct _emacs_addrinfo
{
int ai_family;
***************
*** 1834,1911 ****
struct _emacs_addrinfo *ai_next;
} ai, *res, *lres;
#endif /* HAVE_GETADDRINFO */
int ret = 0;
int xerrno = 0;
int s = -1, outch, inch;
! struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
int retry = 0;
int count = specpdl_ptr - specpdl;
int count1;
int is_non_blocking = 0;
! if (!NILP (non_blocking))
{
#ifndef NON_BLOCKING_CONNECT
return Qnil;
#else
- non_blocking = Qt; /* Instead of GCPRO */
is_non_blocking = 1;
#endif
}
#ifdef WINDOWSNT
/* Ensure socket support is loaded if available. */
init_winsock (TRUE);
#endif
! /* Can only GCPRO 5 variables */
! GCPRO6 (name, buffer, host, service, sentinel, filter);
CHECK_STRING (name);
- CHECK_STRING (host);
! #ifdef HAVE_GETADDRINFO
! /* SERVICE can either be a string or int.
! Convert to a C string for later use by getaddrinfo. */
! if (INTEGERP (service))
! {
! sprintf (portbuf, "%ld", (long) XINT (service));
! portstring = portbuf;
! }
! else
{
CHECK_STRING (service);
! portstring = XSTRING (service)->data;
}
! #else /* HAVE_GETADDRINFO */
! if (INTEGERP (service))
! port = htons ((unsigned short) XINT (service));
! else
{
! CHECK_STRING (service);
! svc_info = getservbyname (XSTRING (service)->data, "tcp");
! if (svc_info == 0)
! error ("Unknown service \"%s\"", XSTRING (service)->data);
! port = svc_info->s_port;
! }
! #endif /* HAVE_GETADDRINFO */
/* Slow down polling to every ten seconds.
Some kernels have a bug which causes retrying connect to fail
after a connect. Polling can interfere with gethostbyname too. */
#ifdef POLL_FOR_INPUT
! record_unwind_protect (unwind_stop_other_atimers, Qnil);
! bind_polling_period (10);
#endif
#ifndef TERM
#ifdef HAVE_GETADDRINFO
immediate_quit = 1;
QUIT;
memset (&hints, 0, sizeof (hints));
hints.ai_flags = 0;
! hints.ai_family = AF_UNSPEC;
! hints.ai_socktype = SOCK_STREAM;
hints.ai_protocol = 0;
ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
if (ret)
--- 1931,2160 ----
struct _emacs_addrinfo *ai_next;
} ai, *res, *lres;
#endif /* HAVE_GETADDRINFO */
+ struct sockaddr_in address;
+ #ifdef AF_LOCAL
+ struct sockaddr_un address_un;
+ #endif
+ struct servent *svc_info;
+ int port;
int ret = 0;
int xerrno = 0;
int s = -1, outch, inch;
! struct gcpro gcpro1, gcpro2, gcpro3;
int retry = 0;
int count = specpdl_ptr - specpdl;
int count1;
int is_non_blocking = 0;
+ int socktype = SOCK_STREAM;
+ int family = -1;
+
+
+ /* Save arguments for process-contact and clone-process. */
+ contact = list5 (host, service, type, filter, sentinel);
! if (CONSP (type))
! {
! Lisp_Object tem = CAR (type);
! type = CDR (type);
! if (INTEGERP (tem))
! family = XINT (tem);
! else
! {
! CHECK_SYMBOL (tem);
! if (NILP (tem))
! family = AF_INET;
! #ifdef AF_LOCAL
! else if (EQ (tem, Qlocal))
! family = AF_LOCAL;
! #endif
! }
! if (family < 0)
! error ("Unknown address family");
! }
!
! CHECK_SYMBOL (type);
! if (NILP (host) && EQ (type, Qt))
! type = Qnil;
! if (EQ (type, Qt))
{
#ifndef NON_BLOCKING_CONNECT
return Qnil;
#else
is_non_blocking = 1;
#endif
}
+ else if (EQ (type, Qdatagram))
+ {
+ #ifndef DATAGRAM_SOCKETS
+ return Qnil;
+ #else
+ socktype = SOCK_DGRAM;
+ #endif
+ }
+ else if (!NILP (type))
+ error ("Unknown connection type");
#ifdef WINDOWSNT
/* Ensure socket support is loaded if available. */
init_winsock (TRUE);
#endif
! GCPRO3 (name, buffer, contact);
CHECK_STRING (name);
! /* Parse SERVICE argument. It is an integer or a string. */
! switch (family)
{
+ #ifdef AF_LOCAL
+ case AF_LOCAL:
CHECK_STRING (service);
!
! bzero (&address_un, sizeof address_un);
! address_un.sun_family = AF_LOCAL;
! strncpy (address_un.sun_path, XSTRING (service)->data, sizeof address_un.sun_path);
! break;
! #endif
!
! default:
! #ifdef HAVE_GETADDRINFO
! /* We don't use getaddrinfo when opening a server socket. */
! if (!NILP (host))
! {
! /* SERVICE can either be a string or int.
! Convert to a C string for later use by getaddrinfo. */
! if (INTEGERP (service))
! {
! sprintf (portbuf, "%ld", (long) XINT (service));
! portstring = portbuf;
! }
! else
! {
! CHECK_STRING (service);
! portstring = XSTRING (service)->data;
! }
! break;
! }
! #endif /* HAVE_GETADDRINFO */
! if (INTEGERP (service))
! port = htons ((unsigned short) XINT (service));
! else
! {
! CHECK_STRING (service);
! svc_info = getservbyname (XSTRING (service)->data,
! (socktype == SOCK_DGRAM ? "udp" : "tcp"));
! if (svc_info == 0)
! report_file_error ("Unknown service", Fcons (service, Qnil));
! port = svc_info->s_port;
! }
! break;
}
!
! /* Open a server socket if no HOST is specified. */
! if (NILP (host))
{
! struct sockaddr *addrp;
! int addrlen;
! int optval = 1;
!
! if (family < 0)
! family = AF_INET;
! s = socket (family, socktype, 0);
! if (s < 0)
! report_file_error ("Cannot create server socket", Qnil);
!
! count1 = specpdl_ptr - specpdl;
! record_unwind_protect (close_file_unwind, make_number (s));
!
! switch (family)
! {
! case AF_LOCAL:
! /* address_un was initialized above. */
! addrp = (struct sockaddr *)&address_un;
! addrlen = sizeof address_un;
! break;
! default:
! bzero (&address, sizeof address);
! address.sin_family = AF_INET;
! address.sin_port = port;
! address.sin_addr.s_addr = INADDR_ANY;
! addrp = (struct sockaddr *)&address;
! addrlen = sizeof address;
!
! if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
! report_file_error ("Cannot set reuse option on server socket.", Qnil);
! break;
! }
!
! if (bind (s, addrp, addrlen))
! report_file_error ("Cannot bind server socket", Qnil);
!
! #ifdef DATAGRAM_SOCKETS
! if (socktype == SOCK_DGRAM)
! {
! if (!datagram_address[s].sa || datagram_address[s].len != addrlen)
! {
! if (datagram_address[s].sa)
! xfree (datagram_address[s].sa);
! datagram_address[s].sa = (struct sockaddr *) xmalloc (addrlen);
! bzero (datagram_address[s].sa, addrlen);
! datagram_address[s].sa->sa_family = addrp->sa_family;
! datagram_address[s].len = addrlen;
! }
! }
! else
! if (datagram_address[s].sa)
! {
! xfree (datagram_address[s].sa);
! datagram_address[s].sa = 0;
! datagram_address[s].len = 0;
! }
! #endif
!
! if (socktype == SOCK_STREAM && listen (s, 5))
! report_file_error ("Cannot listen on server socket", Qnil);
!
! /* Discard the unwind protect closing S. */
! specpdl_ptr = specpdl + count1;
+ goto socket_opened;
+ }
/* Slow down polling to every ten seconds.
Some kernels have a bug which causes retrying connect to fail
after a connect. Polling can interfere with gethostbyname too. */
#ifdef POLL_FOR_INPUT
! if (socktype == SOCK_STREAM)
! {
! record_unwind_protect (unwind_stop_other_atimers, Qnil);
! bind_polling_period (10);
! }
#endif
#ifndef TERM
+ #ifdef AF_LOCAL
+ if (family == AF_LOCAL)
+ {
+ /* Emulate HAVE_GETADDRINFO for the loop over `res' below. */
+ ai.ai_family = AF_LOCAL;
+ ai.ai_socktype = socktype;
+ ai.ai_protocol = 0;
+ ai.ai_addr = (struct sockaddr *) &address_un;
+ ai.ai_addrlen = sizeof address_un;
+ ai.ai_next = NULL;
+ res = &ai;
+ goto open_client_socket;
+ }
+ #endif
+
+ CHECK_STRING (host);
+
#ifdef HAVE_GETADDRINFO
immediate_quit = 1;
QUIT;
memset (&hints, 0, sizeof (hints));
hints.ai_flags = 0;
! hints.ai_family = family == -1 ? AF_UNSPEC : family;
! hints.ai_socktype = socktype;
hints.ai_protocol = 0;
ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
if (ret)
***************
*** 1919,1943 ****
#else /* not HAVE_GETADDRINFO */
! while (1)
! {
! #if 0
! #ifdef TRY_AGAIN
! h_errno = 0;
! #endif
! #endif
! immediate_quit = 1;
! QUIT;
! host_info_ptr = gethostbyname (XSTRING (host)->data);
! immediate_quit = 0;
! #if 0
! #ifdef TRY_AGAIN
! if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN))
! #endif
! #endif
! break;
! Fsleep_for (make_number (1), Qnil);
! }
if (host_info_ptr == 0)
/* Attempt to interpret host as numeric inet address */
--- 2168,2180 ----
#else /* not HAVE_GETADDRINFO */
! /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
! as it may `hang' emacs for a very long time. */
!
! immediate_quit = 1;
! QUIT;
! host_info_ptr = gethostbyname (XSTRING (host)->data);
! immediate_quit = 0;
if (host_info_ptr == 0)
/* Attempt to interpret host as numeric inet address */
***************
*** 1949,1955 ****
host_info_ptr = &host_info;
host_info.h_name = 0;
host_info.h_aliases = 0;
! host_info.h_addrtype = AF_INET;
#ifdef h_addr
/* Older machines have only one address slot called h_addr.
Newer machines have h_addr_list, but #define h_addr to
--- 2186,2192 ----
host_info_ptr = &host_info;
host_info.h_name = 0;
host_info.h_aliases = 0;
! host_info.h_addrtype = family == -1 ? AF_INET : family;
#ifdef h_addr
/* Older machines have only one address slot called h_addr.
Newer machines have h_addr_list, but #define h_addr to
***************
*** 1970,1976 ****
/* Emulate HAVE_GETADDRINFO for the loop over `res' below. */
ai.ai_family = host_info_ptr->h_addrtype;
! ai.ai_socktype = SOCK_STREAM;
ai.ai_protocol = 0;
ai.ai_addr = (struct sockaddr *) &address;
ai.ai_addrlen = sizeof address;
--- 2207,2213 ----
/* Emulate HAVE_GETADDRINFO for the loop over `res' below. */
ai.ai_family = host_info_ptr->h_addrtype;
! ai.ai_socktype = socktype;
ai.ai_protocol = 0;
ai.ai_addr = (struct sockaddr *) &address;
ai.ai_addrlen = sizeof address;
***************
*** 1978,1983 ****
--- 2215,2221 ----
res = &ai;
#endif /* not HAVE_GETADDRINFO */
+ open_client_socket:
/* Do this in case we never enter the for-loop below. */
count1 = specpdl_ptr - specpdl;
s = -1;
***************
*** 1991,1996 ****
--- 2229,2255 ----
continue;
}
+ #ifdef DATAGRAM_SOCKETS
+ if (socktype == SOCK_DGRAM)
+ {
+ if (!datagram_address[s].sa || datagram_address[s].len != lres->ai_addrlen)
+ {
+ if (datagram_address[s].sa)
+ xfree (datagram_address[s].sa);
+ datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen);
+ }
+ bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen);
+ datagram_address[s].len = lres->ai_addrlen;
+ #ifdef HAVE_GETADDRINFO
+ #ifdef AF_LOCAL
+ if (family != AF_LOCAL)
+ #endif
+ freeaddrinfo (res);
+ #endif
+ goto socket_opened;
+ }
+ #endif
+
#ifdef NON_BLOCKING_CONNECT
if (is_non_blocking)
{
***************
*** 2111,2117 ****
report_file_error ("connection failed",
Fcons (host, Fcons (name, Qnil)));
}
!
immediate_quit = 0;
/* Discard the unwind protect, if any. */
--- 2370,2385 ----
report_file_error ("connection failed",
Fcons (host, Fcons (name, Qnil)));
}
!
! #ifdef DATAGRAM_SOCKETS
! if (datagram_address[s].sa)
! {
! xfree (datagram_address[s].sa);
! datagram_address[s].sa = 0;
! datagram_address[s].len = 0;
! }
! #endif
!
immediate_quit = 0;
/* Discard the unwind protect, if any. */
***************
*** 2132,2137 ****
--- 2400,2407 ----
send_command (s, C_DUMB, 1, 0);
#endif /* TERM */
+ socket_opened:
+
inch = s;
outch = s;
***************
*** 2149,2155 ****
#endif
#endif
! XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
XPROCESS (proc)->command_channel_p = Qnil;
XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = sentinel;
--- 2419,2425 ----
#endif
#endif
! XPROCESS (proc)->childp = contact;
XPROCESS (proc)->command_channel_p = Qnil;
XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = sentinel;
***************
*** 2158,2167 ****
XPROCESS (proc)->pid = Qnil;
XSETINT (XPROCESS (proc)->infd, inch);
XSETINT (XPROCESS (proc)->outfd, outch);
! XPROCESS (proc)->status = Qrun;
#ifdef NON_BLOCKING_CONNECT
! if (!NILP (non_blocking))
{
/* We may get here if connect did succeed immediately. However,
in that case, we still need to signal this like a non-blocking
--- 2428,2438 ----
XPROCESS (proc)->pid = Qnil;
XSETINT (XPROCESS (proc)->infd, inch);
XSETINT (XPROCESS (proc)->outfd, outch);
! XPROCESS (proc)->status
! = (NILP (host) && !DATAGRAM_CHAN_P (inch)) ? Qlisten : Qrun;
#ifdef NON_BLOCKING_CONNECT
! if (EQ (type, Qt))
{
/* We may get here if connect did succeed immediately. However,
in that case, we still need to signal this like a non-blocking
***************
*** 2175,2181 ****
}
else
#endif
! if (!EQ (XPROCESS (proc)->filter, Qt))
{
FD_SET (inch, &input_wait_mask);
FD_SET (inch, &non_keyboard_wait_mask);
--- 2446,2453 ----
}
else
#endif
! if (NILP (host) ||
! !EQ (XPROCESS (proc)->filter, Qt))
{
FD_SET (inch, &input_wait_mask);
FD_SET (inch, &non_keyboard_wait_mask);
***************
*** 2343,2348 ****
--- 2615,2701 ----
#endif
}
\f
+ DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
+ 1, 3, 0,
+ doc: /* Get the current datagram address associated with PROCESS.
+ If optional arg NEW-ADDRESS is non-nil, set that as a new datagram
+ address for PROCESS. The old datagram address is still returned,
+ unless the third argument IGNORE-OLD is non-nil. */)
+ (process, new_address, ignore_old)
+ Lisp_Object process, new_address, ignore_old;
+ {
+ Lisp_Object address;
+ int channel, i, len;
+ unsigned char *cp;
+ register struct Lisp_Vector *p;
+ struct sockaddr *sa;
+
+ CHECK_PROCESS (process);
+
+ #ifndef DATAGRAM_SOCKETS
+ return Qnil;
+ #else
+ if (!DATAGRAM_CONN_P (process))
+ return Qnil;
+
+ channel = XPROCESS (process)->infd;
+ sa = datagram_address[channel].sa;
+ if (sa->sa_family == AF_INET)
+ len = 6;
+ else
+ len = datagram_address[channel].len - sizeof(sa->sa_family) + 1;
+
+ if (!NILP (new_address))
+ if (!VECTORP (new_address) ||
+ XVECTOR (new_address)->size != len ||
+ XFASTINT (XVECTOR (new_address)->contents[0]) != sa->sa_family)
+ wrong_type_argument (Qvectorp, new_address);
+
+ if (!NILP (ignore_old))
+ address = Qnil;
+ else
+ {
+ address = Fmake_vector (make_number (len), Qnil);
+ p = XVECTOR (address);
+ i = 0;
+ p->contents[i++] = make_number (sa->sa_family);
+ if (sa->sa_family == AF_INET)
+ {
+ struct sockaddr_in *sin = (struct sockaddr_in *) sa;
+ p->contents[i++] = make_number (ntohs (sin->sin_port));
+ cp = (unsigned char *)&sin->sin_addr;
+ }
+ else
+ cp = (unsigned char *)datagram_address[channel].sa + sizeof (sa->sa_family);
+ while (i < len)
+ p->contents[i++] = make_number (*cp++);
+ }
+
+ if (!NILP (new_address))
+ {
+ p = XVECTOR (new_address);
+ len = p->size;
+ i = 0;
+ if (sa->sa_family == AF_INET)
+ {
+ Lisp_Object port = p->contents[++i];
+ struct sockaddr_in *sin = (struct sockaddr_in *) sa;
+ sin->sin_port = htons (XFASTINT (port));
+ cp = (unsigned char *)&sin->sin_addr;
+ }
+ else
+ cp = (unsigned char *)datagram_address[channel].sa + sizeof (sa->sa_family);
+ while (++i < len)
+ /* result is undefined if vector contains something
+ other than integers. But then it's messed up anyway. */
+ *cp++ = XFASTINT (p->contents[i]) & 0xff;
+ }
+
+ return address;
+ #endif
+ }
+
+ \f
DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
0, 3, 0,
doc: /* Allow any pending output from subprocesses to be read by Emacs.
***************
*** 2411,2416 ****
--- 2764,2956 ----
? Qt : Qnil);
}
+ /* Accept a connection for server process SERVER on CHANNEL. */
+
+ static int connect_counter = 0;
+
+ static void
+ server_accept_connection (server, channel)
+ Lisp_Object server;
+ int channel;
+ {
+ Lisp_Object proc, caller, name, buffer;
+ Lisp_Object host, service;
+ int s;
+ union u_sockaddr {
+ struct sockaddr sa;
+ struct sockaddr_in in;
+ #ifdef AF_LOCAL
+ struct sockaddr_un un;
+ #endif
+ } saddr;
+ int len = sizeof saddr;
+
+ /* TODO: Add GCPRO if necessary. */
+
+ s = accept (channel, &saddr.sa, &len);
+
+ if (s < 0)
+ {
+ int code = errno;
+
+ if (code == EAGAIN)
+ return;
+ #ifdef EWOULDBLOCK
+ if (code == EWOULDBLOCK)
+ return;
+ #endif
+
+ if (!NILP (Vnetwork_server_log_function))
+ apply1 (Vnetwork_server_log_function,
+ list3 (server, Qnil,
+ concat3 (build_string ("accept failed with code"),
+ Fnumber_to_string (make_number (code)),
+ build_string ("\n"))));
+ return;
+ }
+
+ connect_counter++;
+
+ /* Setup a new process to handle the connection. */
+
+ /* Generate a unique identification of the caller, and build contact
+ information for this process. */
+ host = Qt;
+ service = Qnil;
+ switch (saddr.sa.sa_family)
+ {
+ case AF_INET:
+ {
+ Lisp_Object args[5];
+ unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
+ args[0] = build_string ("%d.%d.%d.%d");
+ args[1] = make_number (*ip++);
+ args[2] = make_number (*ip++);
+ args[3] = make_number (*ip++);
+ args[4] = make_number (*ip++);
+ host = Fformat (5, args);
+ service = make_number (ntohs (saddr.in.sin_port));
+
+ args[0] = build_string (" <%s:%d>");
+ args[1] = host;
+ args[2] = service;
+ caller = Fformat (3, args);
+ }
+ break;
+
+ #ifdef AF_LOCAL
+ case AF_LOCAL:
+ #endif
+ default:
+ caller = Fnumber_to_string (make_number (connect_counter));
+ caller = concat3 (build_string (" <*"), caller, build_string ("*>"));
+ break;
+ }
+
+ /* Create a new buffer name for this process if it doesn't have a
+ filter. The new buffer name is based on the buffer name or
+ process name of the server process concatenated with the caller
+ identification. */
+
+ if (!NILP (XPROCESS (server)->filter))
+ buffer = Qnil;
+ else
+ {
+ buffer = XPROCESS (server)->buffer;
+ if (!NILP (buffer))
+ buffer = Fbuffer_name (buffer);
+ else
+ buffer = XPROCESS (server)->name;
+ if (!NILP (buffer))
+ {
+ buffer = concat2 (buffer, caller);
+ buffer = Fget_buffer_create (buffer);
+ }
+ }
+
+ /* Generate a unique name for the new server process. Combine the
+ server process name with the caller identification. */
+
+ name = concat2 (XPROCESS (server)->name, caller);
+ proc = make_process (name);
+
+ chan_process[s] = proc;
+
+ #ifdef O_NONBLOCK
+ fcntl (s, F_SETFL, O_NONBLOCK);
+ #else
+ #ifdef O_NDELAY
+ fcntl (s, F_SETFL, O_NDELAY);
+ #endif
+ #endif
+
+ /* Build new contact information for this setup. */
+ XPROCESS (proc)->childp = Fcopy_sequence (XPROCESS (server)->childp);
+ XSETCAR (XPROCESS (proc)->childp, host);
+ if (!NILP (service))
+ XSETCAR (CDR (XPROCESS (proc)->childp), service);
+
+ XPROCESS (proc)->command_channel_p = Qnil;
+ XPROCESS (proc)->buffer = buffer;
+ XPROCESS (proc)->sentinel = XPROCESS (server)->sentinel;
+ XPROCESS (proc)->filter = XPROCESS (server)->filter;
+ XPROCESS (proc)->command = Qnil;
+ XPROCESS (proc)->pid = Qnil;
+ XSETINT (XPROCESS (proc)->infd, s);
+ XSETINT (XPROCESS (proc)->outfd, s);
+ XPROCESS (proc)->status = Qrun;
+
+ if (!EQ (XPROCESS (proc)->filter, Qt))
+ {
+ FD_SET (s, &input_wait_mask);
+ FD_SET (s, &non_keyboard_wait_mask);
+ }
+
+ if (s > max_process_desc)
+ max_process_desc = s;
+
+ /* Setup coding system for new process based on server process.
+ This seems to be the proper thing to do, as the coding system
+ of the new process should reflect the settings at the time the
+ server socket was opened; not the current settings. */
+
+ XPROCESS (proc)->decode_coding_system = XPROCESS (server)->decode_coding_system;
+ XPROCESS (proc)->encode_coding_system = XPROCESS (server)->encode_coding_system;
+
+ if (!proc_decode_coding_system[s])
+ proc_decode_coding_system[s]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ setup_coding_system (XPROCESS (proc)->decode_coding_system,
+ proc_decode_coding_system[s]);
+ if (!proc_encode_coding_system[s])
+ proc_encode_coding_system[s]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ setup_coding_system (XPROCESS (proc)->encode_coding_system,
+ proc_encode_coding_system[s]);
+
+ XPROCESS (proc)->decoding_buf = make_uninit_string (0);
+ XPROCESS (proc)->decoding_carryover = make_number (0);
+ XPROCESS (proc)->encoding_buf = make_uninit_string (0);
+ XPROCESS (proc)->encoding_carryover = make_number (0);
+
+ XPROCESS (proc)->inherit_coding_system_flag
+ = (NILP (buffer)
+ ? Qnil : XPROCESS (server)->inherit_coding_system_flag);
+
+ if (!NILP (Vnetwork_server_log_function))
+ apply1 (Vnetwork_server_log_function,
+ list3 (server, proc,
+ concat3 (build_string ("accept from "),
+ (STRINGP (host) ? host : build_string ("-")),
+ build_string ("\n"))));
+
+ if (XPROCESS (proc)->sentinel)
+ exec_sentinel (proc,
+ concat3 (build_string ("open from "),
+ (STRINGP (host) ? host : build_string ("-")),
+ build_string ("\n")));
+ }
+
/* This variable is different from waiting_for_input in keyboard.c.
It is used to communicate to a lisp process-filter/sentinel (via the
function Fwaiting_for_user_input_p below) whether emacs was waiting
***************
*** 2909,2914 ****
--- 3449,3462 ----
if (NILP (proc))
continue;
+ /* If this is a server stream socket, accept connection. */
+ if (EQ (XPROCESS (proc)->status, Qlisten)
+ && !DATAGRAM_CHAN_P (channel))
+ {
+ server_accept_connection (proc, channel);
+ continue;
+ }
+
/* Read data from the process, starting with our
buffered-ahead character if we have one. */
***************
*** 2983,2989 ****
{
struct Lisp_Process *p;
struct sockaddr pname;
! socklen_t pnamelen = sizeof(pname);
FD_CLR (channel, &connect_wait_mask);
if (--num_pending_connects < 0)
--- 3531,3537 ----
{
struct Lisp_Process *p;
struct sockaddr pname;
! int pnamelen = sizeof(pname);
FD_CLR (channel, &connect_wait_mask);
if (--num_pending_connects < 0)
***************
*** 2999,3005 ****
/* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
So only use it on systems where it is known to work. */
{
! socklen_t xlen = sizeof(xerrno);
if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
xerrno = errno;
}
--- 3547,3553 ----
/* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
So only use it on systems where it is known to work. */
{
! int xlen = sizeof(xerrno);
if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
xerrno = errno;
}
***************
*** 3106,3111 ****
--- 3654,3660 ----
register int opoint;
struct coding_system *coding = proc_decode_coding_system[channel];
int carryover = XINT (p->decoding_carryover);
+ int readmax = 1024;
#ifdef VMS
VMS_PROC_STUFF *vs, *get_vms_process_pointer();
***************
*** 3137,3154 ****
bcopy (vs->inputBuffer, chars + carryover, nbytes);
}
#else /* not VMS */
! chars = (char *) alloca (carryover + 1024);
if (carryover)
/* See the comment above. */
bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
if (proc_buffered_char[channel] < 0)
! nbytes = emacs_read (channel, chars + carryover, 1024 - carryover);
else
{
chars[carryover] = proc_buffered_char[channel];
proc_buffered_char[channel] = -1;
! nbytes = emacs_read (channel, chars + carryover + 1, 1023 - carryover);
if (nbytes < 0)
nbytes = 1;
else
--- 3686,3724 ----
bcopy (vs->inputBuffer, chars + carryover, nbytes);
}
#else /* not VMS */
!
! #ifdef DATAGRAM_SOCKETS
! /* A datagram is one packet; allow at least 1500+ bytes of data
! corresponding to the typical Ethernet frame size. */
! if (DATAGRAM_CHAN_P (channel))
! {
! /* carryover = 0; */ /* Does carryover make sense for datagrams? */
! readmax += 1024;
! }
! #endif
!
! chars = (char *) alloca (carryover + readmax);
if (carryover)
/* See the comment above. */
bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
+ #ifdef DATAGRAM_SOCKETS
+ /* We have a working select, so proc_buffered_char is always -1. */
+ if (DATAGRAM_CHAN_P (channel))
+ {
+ int len = datagram_address[channel].len;
+ nbytes = recvfrom (channel, chars + carryover, readmax - carryover,
+ 0, datagram_address[channel].sa, &len);
+ }
+ else
+ #endif
if (proc_buffered_char[channel] < 0)
! nbytes = emacs_read (channel, chars + carryover, readmax - carryover);
else
{
chars[carryover] = proc_buffered_char[channel];
proc_buffered_char[channel] = -1;
! nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1 - carryover);
if (nbytes < 0)
nbytes = 1;
else
***************
*** 3614,3622 ****
/* Send this batch, using one or more write calls. */
while (this > 0)
{
old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
! rv = emacs_write (XINT (XPROCESS (proc)->outfd),
! (char *) buf, this);
signal (SIGPIPE, old_sigpipe);
if (rv < 0)
--- 4184,4203 ----
/* Send this batch, using one or more write calls. */
while (this > 0)
{
+ int outfd = XINT (XPROCESS (proc)->outfd);
old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
! #ifdef DATAGRAM_SOCKETS
! if (DATAGRAM_CHAN_P (outfd))
! {
! rv = sendto (outfd, (char *) buf, this,
! 0, datagram_address[outfd].sa,
! datagram_address[outfd].len);
! if (rv < 0 && errno == EMSGSIZE)
! report_file_error ("sending datagram", Fcons (proc, Qnil));
! }
! else
! #endif
! rv = emacs_write (outfd, (char *) buf, this);
signal (SIGPIPE, old_sigpipe);
if (rv < 0)
***************
*** 4235,4240 ****
--- 4816,4824 ----
Lisp_Object proc;
struct coding_system *coding;
+ if (DATAGRAM_CONN_P (process))
+ return process;
+
proc = get_process (process);
coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
***************
*** 4829,4834 ****
--- 5413,5421 ----
}
bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
+ #ifdef DATAGRAM_SOCKETS
+ bzero (datagram_address, sizeof datagram_address);
+ #endif
}
void
***************
*** 4857,4862 ****
--- 5444,5455 ----
staticpro (&Qconnect);
Qfailed = intern ("failed");
staticpro (&Qfailed);
+ Qlisten = intern ("listen");
+ staticpro (&Qlisten);
+ Qlocal = intern ("local");
+ staticpro (&Qlocal);
+ Qdatagram = intern ("datagram");
+ staticpro (&Qdatagram);
Qlast_nonmenu_event = intern ("last-nonmenu-event");
staticpro (&Qlast_nonmenu_event);
***************
*** 4877,4882 ****
--- 5470,5481 ----
The value takes effect when `start-process' is called. */);
Vprocess_connection_type = Qt;
+ DEFVAR_LISP ("network-server-log-function", &Vnetwork_server_log_function,
+ doc: /* Function called when accepting a network connecting.
+ Arguments are SERVER, PROCESS, and MESSAGE, where SERVER is the server process,
+ PROCESS is the new process for the connection, and MESSAGE is a string. */);
+ Vnetwork_server_log_function = Qnil;
+
defsubr (&Sprocessp);
defsubr (&Sget_process);
defsubr (&Sget_buffer_process);
***************
*** 4906,4911 ****
--- 5505,5511 ----
defsubr (&Sopen_network_stream);
#endif /* HAVE_SOCKETS */
defsubr (&Saccept_process_output);
+ defsubr (&Sprocess_datagram_address);
defsubr (&Sprocess_send_region);
defsubr (&Sprocess_send_string);
defsubr (&Sinterrupt_process);
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-07 0:08 ` New patch for server sockets and datagram (UDP) support Kim F. Storm
@ 2002-03-07 10:56 ` Kim F. Storm
2002-03-07 11:39 ` Alex Schroeder
2002-03-07 15:18 ` New " Helmut Eller
2002-03-07 12:54 ` Mario Lang
2002-03-08 9:09 ` Richard Stallman
2 siblings, 2 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-03-07 10:56 UTC (permalink / raw)
Cc: helmut
I wrote:
> The following patch adds server socket support via open-network-stream.
> If the HOST is nil, a server socket for SERVICE is opened in listening
> state.
>
I forgot to say, that the code is working nicely, but the patch is
still "work in progress" to let you know how this is progressing and
get your comments on the direction it is taking.
> I have removed the NON-BLOCKING argument, and instead added a new TYPE
> argument, which specifies the type of connection (blocking connect,
> non-blocking connect, or datagram), and may optionally specify the
> address family (inet or local [aka. unix]).
Actually, I would like to get rid of this extra TYPE argument
all together by modifying the HOST and SERVICE arguments in a
backwards compatible way (when calling open-network-stream):
When the HOST and SERVICE are specified as "simple" arguments (strings
or integer port number), a TCP/IP connection is created using a
blocking connect.
To get a non-blocking TCP connect, or a datagram socket, the SERVICE
argument is a cons (TYPE . SERVICE), where TYPE is t for a non-blocking
connect, and `datagram' for a datagram socket.
Likewise, to use another address/protocol family than IP, the HOST
argument is a cons (FAMILY . HOST), where FAMILY is `local' for
a local (aka UNIX) socket.
Also, I think that HOST should be t to get a server socket rather
than nil. This is because, for a local (UNIX) socket, there is no
hostname, so the hostname would logically be nil for a client.
However, there is one problem with this approach:
The value returned from `process-contact' for a network stream is
specified to be (HOST SERVICE) -- which my patch modifies to
(HOST SERVICE TYPE FILTER SENTINEL).
The only use I've found for process-contact is in the clone-process
function where it is obviously assumed to return the parameters
originally given to open-network-stream (thus the change).
Now, if I want to get rid of TYPE by modifing the possible arguments
for HOST and SERVICE, this would obviously have to be reflected in
the value returned by process-contact as well.
So if code currently exists which expects (car (process-contact p)) or
(cadr (process-contact p)) to return the hostname or service, that
code will fail after the change. But I haven't found any such code
though -- do you know of any code using process-contact?
My suggestion is to change `process-contact' to do the following:
For a network conntecton, the value is a list (HOST SERVICE FILTER SENTINEL)
with the same format as the corresponding arguments to `open-network-stream'.
The current doc string says:
For a net connection, the value is a cons cell of the form (HOST SERVICE).
Below you can see the difference between using the TYPE argument
and encoding the information in the HOST and SERVICE args (and
using HOST=t for a server socket).
>
> To open a TCP server socket for "telnet", where client
> processes have no buffer, do
>
> (open-network-stream "telnetd" nil nil "telnet" nil
> telnetd-filter telnetd-sentinel)
(open-network-stream "telnetd" nil t "telnet"
telnetd-filter telnetd-sentinel)
>
> To open a UDP (datagram) server socket for "dns", do
>
> (open-network-stream "dns" nil nil "dns" 'datagram
> dns-filter dns-sentinel)
(open-network-stream "dns" nil t '(datagram . "dns")
dns-filter dns-sentinel)
>
> To open a LOCAL (UNIX) server socket for "/tmp/xyz", where
> client processes do have a buffer, do
>
> (open-network-stream "xyz" "XYZ" nil "/tmp/xyz" '(local)
> xyz-filter xyz-sentinel)
(open-network-stream "xyz" "XYZ" '(local . t) "/tmp/xyz"
xyz-filter xyz-sentinel)
To connect to each of these services, specify the hostname (or nil for
a local socket) instead of t in the third argument (and modify other
parameters according to the desired use), e.g.
;; non-blocking connect, use buffer, no filter
(open-network-stream "telnet" "TELNET" "hostname" '(t . "telnet")
nil telnet-client-sentinel)
;; datagram "connect", no buffer, use filter
(open-network-stream "dns" nil "hostname" '(datagram . "dns")
dns-filter dns-sentinel)
;; local socket, non-blocking connect, use buffer, no filter
(open-network-stream "xyz" "XYZ" '(local) '(t . "/tmp/xyz")
nil xyz-sentinel)
What do you think?
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-07 10:56 ` Kim F. Storm
@ 2002-03-07 11:39 ` Alex Schroeder
2002-03-07 12:39 ` Kim F. Storm
2002-03-07 15:18 ` New " Helmut Eller
1 sibling, 1 reply; 46+ messages in thread
From: Alex Schroeder @ 2002-03-07 11:39 UTC (permalink / raw)
storm@cua.dk (Kim F. Storm) writes:
> Actually, I would like to get rid of this extra TYPE argument
> all together by modifying the HOST and SERVICE arguments in a
> backwards compatible way (when calling open-network-stream):
Can you explain the benefit of such a change? AFAICT, you described
the changes, discussed a potential problem, but there seemed to be no
advantages. Personally, I like it when information is transmitted via
arguments instead of datastructures, ie. I prefer a TYPE argument to
encoding information in a cons cell (TYPE . SERVICE).
What about the comments by Mario and Helmut. I think Mario wants to
implement DCC for an IRC client, and I think he needs to be able to
*not* specify a port. Here's the quote from
http://www.irchelp.org/irchelp/rfc/ctcpspec.html:
The initial socket for a DCC connection is created by the side
that initiates (Offers) the connection. This socket should be
a TCP socket bound to INADDR_ANY, listening for connections.
Other than that, I note that currently we have (open-network-stream
NAME BUFFER HOST SERVICE) and later we will have (open-network-stream
NAME BUFFER HOST SERVICE TYPE FILTER SENTINEL) or something
similar... Since the function is the same, we cannot test using
boundp but will habe to use some condition-case in order to handle
XEmacs or older versions of Emacs, correct?
Perhaps splitting these things up into more functions might be easier
to understand and document. One lisp function for one type of
functionality, instead of big black boxes to do it all. If we still
want a blackbox, we could write it later using the two or three
existing functions.
Alex.
--
http://www.emacswiki.org/
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-07 11:39 ` Alex Schroeder
@ 2002-03-07 12:39 ` Kim F. Storm
2002-03-07 14:51 ` Alex Schroeder
2002-03-08 21:06 ` Richard Stallman
0 siblings, 2 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-03-07 12:39 UTC (permalink / raw)
Cc: emacs-devel
Alex Schroeder <alex@gnu.org> writes:
> storm@cua.dk (Kim F. Storm) writes:
>
> > Actually, I would like to get rid of this extra TYPE argument
> > all together by modifying the HOST and SERVICE arguments in a
> > backwards compatible way (when calling open-network-stream):
>
> Can you explain the benefit of such a change? AFAICT, you described
> the changes, discussed a potential problem, but there seemed to be no
> advantages. Personally, I like it when information is transmitted via
> arguments instead of datastructures, ie. I prefer a TYPE argument to
> encoding information in a cons cell (TYPE . SERVICE).
Yes, that is the other route we can take - and then also split the
current TYPE argument into TYPE and FAMILY. I have absolutely no
objections to doing that -- actually, that it what I originally wanted
to do, but then I was told that open-network-stream has too
many arguments already...
So expect to see 8 arguments in the next version :-)
>
> What about the comments by Mario and Helmut. I think Mario wants to
> implement DCC for an IRC client, and I think he needs to be able to
> *not* specify a port. Here's the quote from
> http://www.irchelp.org/irchelp/rfc/ctcpspec.html:
>
> The initial socket for a DCC connection is created by the side
> that initiates (Offers) the connection. This socket should be
> a TCP socket bound to INADDR_ANY, listening for connections.
Ok, I'll add that. The selected port number will be available in
(cadr (process-contact ddc)) (i.e. the SERVICE element).
>
> Other than that, I note that currently we have (open-network-stream
> NAME BUFFER HOST SERVICE) and later we will have (open-network-stream
> NAME BUFFER HOST SERVICE TYPE FILTER SENTINEL) or something
> similar... Since the function is the same, we cannot test using
> boundp but will habe to use some condition-case in order to handle
> XEmacs or older versions of Emacs, correct?
Although not very obvious, you can use
(boundp 'network-server-log-function)
to test for server socket support.
And you can use
(fboundp 'process-datagram-address)
to test for datagram support [if I change the code so that
this function is only available when DATAGRAM_SOCKETS is
defined.]
Alternatively, using something like
(featurep 'server-sockets)
(featurep 'datagram-sockets)
would be a more generic approach.
>
> Perhaps splitting these things up into more functions might be easier
> to understand and document. One lisp function for one type of
> functionality, instead of big black boxes to do it all. If we still
> want a blackbox, we could write it later using the two or three
> existing functions.
>
I agree that the combined functionality of open-network-stream
is a large "black box". But why is that a problem? Maybe it
isn't very pretty (it wasn't that before either), but it shares
a fair amount of code and functionality between the various
uses of the function.
IMO, We should do what you suggest, but the other way round:
We could rename the C-level function to, say, open-network-connection
and write lisp-level wrappers (in simple.el) around it like
open-network-stream, open-network-stream-nowait, open-network-stream-server,
open-local-stream-nowait, open-local-stream, open-local-stream-server,
open-datagram-server, open-datagram-client,
etc. etc.
Then you don't have 10 different C functions all doing variations of
the same thing, but still the user will have all the `specific-purpose'
functions handy.
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-07 0:08 ` New patch for server sockets and datagram (UDP) support Kim F. Storm
2002-03-07 10:56 ` Kim F. Storm
@ 2002-03-07 12:54 ` Mario Lang
2002-03-07 12:58 ` Kim F. Storm
2002-03-08 9:09 ` Richard Stallman
2 siblings, 1 reply; 46+ messages in thread
From: Mario Lang @ 2002-03-07 12:54 UTC (permalink / raw)
storm@cua.dk (Kim F. Storm) writes:
> Richard Stallman <rms@gnu.org> writes:
>
> > If the HOST argument is nil, a server socket is opened which
> > accepts connections. The sentinel is called - with a newly
> > created process - whenever a connections is accepted.
> >
> > That sounds good to me in principle, if the details work ok.
>
> The following patch adds server socket support via open-network-stream.
> If the HOST is nil, a server socket for SERVICE is opened in listening
> state.
OK, I compiled my emacs and played a bit with it.
Here come my issues:
1. How do I bind to a random port? Normally, port 0 is used
for that. I tried, it only partially works. I had Emacs listen on 42266 then, but:
(setq my-process (open-network-stream "dcc" nil nil 0))
(process-contact my-process)
=> (nil 0 nil nil nil)
Is it possible that process-contact would return the real port where
Emacs is listening on?
(BTW, the docstring of process-contact is wrong)
Here is what netstat -lp told me after the code above was executed:
tcp 0 0 *:42266 *:* LISTEN 25203/emacs
2. How am I supposed to bind to localhost only e.g.
with this implementation???
--
Regards,
Mario <mlang@delysid.org>
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-07 12:54 ` Mario Lang
@ 2002-03-07 12:58 ` Kim F. Storm
0 siblings, 0 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-03-07 12:58 UTC (permalink / raw)
Cc: emacs-devel
Mario Lang <mlang@delysid.org> writes:
> storm@cua.dk (Kim F. Storm) writes:
>
> > Richard Stallman <rms@gnu.org> writes:
> >
> > > If the HOST argument is nil, a server socket is opened which
> > > accepts connections. The sentinel is called - with a newly
> > > created process - whenever a connections is accepted.
> > >
> > > That sounds good to me in principle, if the details work ok.
> >
> > The following patch adds server socket support via open-network-stream.
> > If the HOST is nil, a server socket for SERVICE is opened in listening
> > state.
> OK, I compiled my emacs and played a bit with it.
>
> Here come my issues:
>
> 1. How do I bind to a random port? Normally, port 0 is used
> for that. I tried, it only partially works. I had Emacs listen on 42266 then, but:
>
> (setq my-process (open-network-stream "dcc" nil nil 0))
> (process-contact my-process)
> => (nil 0 nil nil nil)
>
> Is it possible that process-contact would return the real port where
> Emacs is listening on?
Yes, I'll add a call to getsockname after bind if the port number is 0
and patch the actual port number into the process-contact list.
> (BTW, the docstring of process-contact is wrong)
I know :-)
>
> 2. How am I supposed to bind to localhost only e.g.
> with this implementation???
Hmm, yes, that is a good question.
Referring to my recent answer to Alex on emacs-devel, I guess the
"clean" approach to this problem is to just add a 9th argument,
SERVER, to open-network-connection rather than overloading the
HOST argument ...
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-07 12:39 ` Kim F. Storm
@ 2002-03-07 14:51 ` Alex Schroeder
2002-03-08 21:06 ` Richard Stallman
1 sibling, 0 replies; 46+ messages in thread
From: Alex Schroeder @ 2002-03-07 14:51 UTC (permalink / raw)
Cc: emacs-devel
storm@cua.dk (Kim F. Storm) writes:
> Yes, that is the other route we can take - and then also split the
> current TYPE argument into TYPE and FAMILY. I have absolutely no
> objections to doing that -- actually, that it what I originally wanted
> to do, but then I was told that open-network-stream has too
> many arguments already...
Haha, that was a cheap trick, then. :) Anyway, if you provide a list
of special purpose functions as discussed at the end, then this is a
non-issue anyway. Thanks.
>> The initial socket for a DCC connection is created by the side
>> that initiates (Offers) the connection. This socket should be
>> a TCP socket bound to INADDR_ANY, listening for connections.
>
> Ok, I'll add that. The selected port number will be available in
> (cadr (process-contact ddc)) (i.e. the SERVICE element).
Thanks for considering this.
> Alternatively, using something like
> (featurep 'server-sockets)
> (featurep 'datagram-sockets)
> would be a more generic approach.
That would be nice, or combined with the functions you mention next,
this seems good.
> We could rename the C-level function to, say, open-network-connection
> and write lisp-level wrappers (in simple.el) around it like
> open-network-stream, open-network-stream-nowait, open-network-stream-server,
> open-local-stream-nowait, open-local-stream, open-local-stream-server,
> open-datagram-server, open-datagram-client,
> etc. etc.
>
> Then you don't have 10 different C functions all doing variations of
> the same thing, but still the user will have all the `specific-purpose'
> functions handy.
That sounds ok to me because I only care about the Lisp level.
Other people shall judge maintenace issues or code issues on the C
level.
Thanks, Kim.
Alex.
--
http://www.emacswiki.org/
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-07 10:56 ` Kim F. Storm
2002-03-07 11:39 ` Alex Schroeder
@ 2002-03-07 15:18 ` Helmut Eller
2002-03-07 16:09 ` Kim F. Storm
1 sibling, 1 reply; 46+ messages in thread
From: Helmut Eller @ 2002-03-07 15:18 UTC (permalink / raw)
Cc: emacs-devel
storm@cua.dk (Kim F. Storm) writes:
> What do you think?
You are adding many features at the same time; it's a bit hard to see
what your problem actually is :-)
I think it's a _very good_ idea to rename open-network-stream to
something different, because this frees you from being backward
compatible.
Have you considered to use keyword arguments, e.g., in the spirit of
the make-socket function found in Allegro CL?
<http://www.franz.com/support/documentation/5.0.1/doc/cl/socket.htm>
It's probably a pain to parse keyword arguments in C, but it frees you
from overloading positional arguments in an unnatural way. It would
also be quite nice to use from Lisp. Another advantage is that you
could add new arguments without much backward compatibility
restrictions.
Another point: if someone wants to bind a socket to a specific
interface he must be able to specify the IP address, the hostname is
IMHO not sufficient for this. Any ideas for this problem? I propose
to make gethostbyname and related functions available to Lisp. IP
addresses could be represented by vectors of 4 bytes (it's a pity that
32bit don't fit into a ELisp fixnum).
Yet another point: please, please, please make accept-connection a
separate function. Then one could make a _blocking_ accept; also
accept with a timeout argument would be possible. Would this add any
implementation complexity?
Helmut.
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-07 15:18 ` New " Helmut Eller
@ 2002-03-07 16:09 ` Kim F. Storm
2002-03-07 17:32 ` Helmut Eller
0 siblings, 1 reply; 46+ messages in thread
From: Kim F. Storm @ 2002-03-07 16:09 UTC (permalink / raw)
Cc: emacs-devel
Helmut Eller <helmut@xaital.km4u.net> writes:
Thanks Helmut,
I appreciate your comments. See below.
> storm@cua.dk (Kim F. Storm) writes:
>
> > What do you think?
>
> You are adding many features at the same time; it's a bit hard to see
> what your problem actually is :-)
I agree -- but doing it all in one big step does reveal more of the
API related problems than doing it step by step (as I did with the
non-blocking argument to open-network-stream).
> I think it's a _very good_ idea to rename open-network-stream to
> something different, because this frees you from being backward
> compatible.
That's right. It definitely has advantages to do that.
>
> Have you considered to use keyword arguments, e.g., in the spirit of
> the make-socket function found in Allegro CL?
> <http://www.franz.com/support/documentation/5.0.1/doc/cl/socket.htm>
>
I have considered doing that, but I don't think there is any tradition
for doing that in emacs lisp built-in functions. But I agree that it
gives more flexibility in combining various options, so if that is
ok with the rest of the developers, I will look into that path.
> It's probably a pain to parse keyword arguments in C, but it frees you
> from overloading positional arguments in an unnatural way. It would
> also be quite nice to use from Lisp. Another advantage is that you
> could add new arguments without much backward compatibility
> restrictions.
It still has the problem of what to do with unknown arguments --
but at least it will not trigger the debugger due to an incorrect
number of arguments.
>
> Another point: if someone wants to bind a socket to a specific
> interface he must be able to specify the IP address, the hostname is
> IMHO not sufficient for this. Any ideas for this problem?
I'll have to think about that, but again keyword arguments could
be helpful here.
> I propose
> to make gethostbyname and related functions available to Lisp. IP
> addresses could be represented by vectors of 4 bytes (it's a pity that
> 32bit don't fit into a ELisp fixnum).
>
Not that I object to this in general, but for what purpose?
> Yet another point: please, please, please make accept-connection a
> separate function. Then one could make a _blocking_ accept; also
> accept with a timeout argument would be possible.
I understand that you want to serialize the connections.
Why is it necessary to do that? Each connection gets its own
process (and buffer etc), so they should be able to co-exist.
If it is a matter of resources, then I think there are other ways we
could consider to handle this (e.g. a `:max-conn 5' parameter) to
limit the number of concurrent servers running. Or we could make the
`stop-process' function applicable to server sockets to stop/start
listening.
AFAICS, your accept-connection call doesn't really accept anything;
it just allows the server to accept a (one) connection if one is
received. If you don't want to accept more connections, you can
delete the server process in the sentinel.
And you can start a timer to cancel the accept (by calling
delete-process) if a connection hasn't been received.
The sentinel can cancel (or restart) that timer if a
connection is accepted.
> Would this add any > implementation complexity?
Yes. (I'll elaborate more on this when I understand what
you are trying to accomplish).
>
> Helmut.
>
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-07 16:09 ` Kim F. Storm
@ 2002-03-07 17:32 ` Helmut Eller
2002-03-07 23:58 ` Kim F. Storm
0 siblings, 1 reply; 46+ messages in thread
From: Helmut Eller @ 2002-03-07 17:32 UTC (permalink / raw)
Cc: emacs-devel
no-spam@cua.dk (Kim F. Storm) writes:
> > It's probably a pain to parse keyword arguments in C, but it frees you
> > from overloading positional arguments in an unnatural way. It would
> > also be quite nice to use from Lisp. Another advantage is that you
> > could add new arguments without much backward compatibility
> > restrictions.
>
> It still has the problem of what to do with unknown arguments --
> but at least it will not trigger the debugger due to an incorrect
> number of arguments.
Raise an "invalid keyword" error. That's the pain it was talking
about.
> > I propose
> > to make gethostbyname and related functions available to Lisp. IP
> > addresses could be represented by vectors of 4 bytes (it's a pity that
> > 32bit don't fit into a ELisp fixnum).
> >
>
> Not that I object to this in general, but for what purpose?
Because there is currently no way to get the IP address(es) of the
current host. It MAY also simplify the C level implementation,
because you could require that e.g. the SERVICE argument is actually a
port number and not a string or a number; similar for the HOST
argument.
> > Yet another point: please, please, please make accept-connection a
> > separate function. Then one could make a _blocking_ accept; also
> > accept with a timeout argument would be possible.
>
> I understand that you want to serialize the connections.
> Why is it necessary to do that?
It's probably not necessary in 95% of all uses, but it may be hard to
change later if you hardwire the current behavior. And, about every
socket interface I have seen so far has a separate accept function.
Here is a somewhat artificial example. I would like to control Emacs
from an external Common Lisp program. I would also like to control
the Common Lisp program from Emacs. Do to this I implemented a very
naive rpc mechanism: both sides send their commands via a socket
connection to the peer, the peer evals the command and sends the
result back to the client. Now the problem: if the command include a
recursive/nested calls to caller, serialization is an issue. The
cleanest thing is to accept exactly one connection at a time. Of
course, it is not very hard to come up with different solution, but
accept-connection makes this particular use elegant and reliable.
> And you can start a timer to cancel the accept (by calling
> delete-process) if a connection hasn't been received.
> The sentinel can cancel (or restart) that timer if a
> connection is accepted.
Yes I could. But a blocking accept is easier to use and more
reliable.
If you think a separate function is to much trouble, leave it out.
Helmut.
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-07 17:32 ` Helmut Eller
@ 2002-03-07 23:58 ` Kim F. Storm
2002-03-08 7:38 ` Helmut Eller
0 siblings, 1 reply; 46+ messages in thread
From: Kim F. Storm @ 2002-03-07 23:58 UTC (permalink / raw)
Cc: emacs-devel
Helmut Eller <helmut@xaital.km4u.net> writes:
> > > It's probably a pain to parse keyword arguments in C, but it frees you
> > > from overloading positional arguments in an unnatural way. It would
> > > also be quite nice to use from Lisp. Another advantage is that you
> > > could add new arguments without much backward compatibility
> > > restrictions.
Below is the doc-string for make-network-process which is a keyword
based replacement for the built-in open-network-stream. I already
implemented most of the code handling this, and it looks quite clean
compared to the previous version.
IMO, this it by far the best proposal for the API so far.
The lisp-level wrappers will look like this:
(defun open-network-stream (name buffer host service)
"..."
(make-network-process :name name :buffer buffer
:host host :service service))
(defun open-network-stream-nowait (name buffer host service &optional sentinel filter)
"..."
(if (make-network-process :feature :nowait t)
(make-network-process :name name :buffer buffer :nowait t
:host host :service service
:filter filter :sentinel sentinel)))
(defun open-stream-server (name buffer service &optional host sentinel filter)
"..."
(make-network-process :name name :buffer buffer :server t
:host host :service service))
DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
0, MANY, 0,
doc: /* Create and return a network server or client process.
Input and output work as for subprocesses; `delete-process' closes it.
Arguments are specified as keyword/argument pairs. The following
arguments are defined:
:name NAME -- NAME is name for process. It is modified if necessary
to make it unique.
:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
with the process. Process output goes at end of that buffer, unless
you specify an output stream or filter function to handle the output.
BUFFER may be also nil, meaning that this process is not associated
with any buffer.
:host HOST -- HOST is name of the host to connect to, or its IP
address. If specified for a server process, only clients on that host
may connect. The symbol `local' specifies the local host.
:service SERVICE -- SERVICE is name of the service desired, or an
integer specifying a port number to connect to. If port number is 0,
a random port number is selected for the
:family FAMILY -- FAMILY is the address (and protocol) family for the
service specified by HOST and SERVICE. The default address family is
Inet (or IPv4) for the host and port number specified by HOST and
SERVICE. Other address families supported are:
local -- for a local (i.e. UNIX) address specified by SERVICE.
:datagram BOOL -- Create a datagram type connection if BOOL is
non-nil. Default is a stream type connection.
:nowait BOOL -- Don't wait for client process to complete the
connection to the server if BOOL is non-nil; instead, the sentinel
function will be called with second matching "open" (if successful) or
"failed" when the connect completes. Default is to use a blocking
connect.
:filter FILTER -- Install FILTER as the process filter.
:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
:server BOOL -- if BOOL is non-nil, create a server process for the
specified FAMILY, SERVICE, and connection type (stream or datagram).
Default is a client process.
A server process will listen for and accept connections from
clients. When a client connection is accepted, a new network process
is created for the connection with the following parameters:
- The client's process name is constructed by concatenating the server
process' NAME and a client identification string.
- If the FILTER argument is non-nil, the client process will not get a
separate process buffer; otherwise, the client's process buffer is a newly
created buffer named after the server process' BUFFER name or process
NAME concatenated with the client identification string.
- The connection type and the process filter and sentinel parameters are
inherited from the server process' TYPE, FILTER and SENTINEL.
- The client process' contact info is set according to the client's
addressing information (typically an IP address and a port number).
Notice that the FILTER and SENTINEL args are never used directly by
the server process. Also, the BUFFER argument is not used directly by
the server process, but via `network-server-log-function' hook, a log
of the accepted (and failed) connections may be recorded in the server
process' buffer.
The following special call returns t iff a given KEY VALUE
pair is supported on this system:
(make-network-process :feature KEY VALUE) */)
(nargs, args)
int nargs;
Lisp_Object *args;
>
> > > I propose
> > > to make gethostbyname and related functions available to Lisp. IP
> > > addresses could be represented by vectors of 4 bytes (it's a pity that
> > > 32bit don't fit into a ELisp fixnum).
> > >
> >
> > Not that I object to this in general, but for what purpose?
>
> Because there is currently no way to get the IP address(es) of the
> current host. It MAY also simplify the C level implementation,
> because you could require that e.g. the SERVICE argument is actually a
> port number and not a string or a number; similar for the HOST
> argument.
>
I don't think this is necessary, so I'll leave that for a future
enhancement. To restrict connections to the local host, I suggest
using either "localhost" for the HOST or as local (UNIX) socket.
> > > Yet another point: please, please, please make accept-connection a
> > > separate function. Then one could make a _blocking_ accept; also
> > > accept with a timeout argument would be possible.
> >
> > I understand that you want to serialize the connections.
> > Why is it necessary to do that?
>
> It's probably not necessary in 95% of all uses, but it may be hard to
> change later if you hardwire the current behavior. And, about every
> socket interface I have seen so far has a separate accept function.
>
> Here is a somewhat artificial example. I would like to control Emacs
> from an external Common Lisp program. I would also like to control
> the Common Lisp program from Emacs. Do to this I implemented a very
> naive rpc mechanism: both sides send their commands via a socket
> connection to the peer, the peer evals the command and sends the
> result back to the client. Now the problem: if the command include a
> recursive/nested calls to caller, serialization is an issue. The
> cleanest thing is to accept exactly one connection at a time. Of
> course, it is not very hard to come up with different solution, but
> accept-connection makes this particular use elegant and reliable.
>
Ok, but as you mention yourself, this is the exception, so it
shouldn't be the standard behaviour. I will take a look at using
stop-process and start-process to temporarily inhibit a server socket
from accepting connections. If you can use stop-process in
the sentinel, this seems to be a cleaner solution than
having to (re-)enable the server by calling accept-connection.
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-07 23:58 ` Kim F. Storm
@ 2002-03-08 7:38 ` Helmut Eller
2002-03-08 9:13 ` Kim F. Storm
2002-03-08 21:07 ` Richard Stallman
0 siblings, 2 replies; 46+ messages in thread
From: Helmut Eller @ 2002-03-08 7:38 UTC (permalink / raw)
Cc: emacs-devel
storm@cua.dk (Kim F. Storm) writes:
> Below is the doc-string for make-network-process which is a keyword
> based replacement for the built-in open-network-stream. I already
> implemented most of the code handling this, and it looks quite clean
> compared to the previous version.
>
> IMO, this it by far the best proposal for the API so far.
Yes. This looks very good now.
> :nowait BOOL -- Don't wait for client process to complete the
> connection to the server if BOOL is non-nil; instead, the sentinel
> function will be called with second matching "open" (if successful) or
> "failed" when the connect completes. Default is to use a blocking
> connect.
I would prefer :wait that defaults to t. Is shorter and avoids the
negation.
> Notice that the FILTER and SENTINEL args are never used directly by
> the server process. Also, the BUFFER argument is not used directly by
> the server process, but via `network-server-log-function' hook, a log
> of the accepted (and failed) connections may be recorded in the server
> process' buffer.
network-server-log-function is a global variable. This may cause
problems when used by independent packages. Is it a problem to make
this an attribute of the server process? E.g. as :log-function
argument?
> The following special call returns t iff a given KEY VALUE
> pair is supported on this system:
> (make-network-process :feature KEY VALUE) */)
Hmm... this looks a bit strange. Can you give some examples?
Especially, what do you supply as VALUE?
> > Because there is currently no way to get the IP address(es) of the
> > current host. It MAY also simplify the C level implementation,
> > because you could require that e.g. the SERVICE argument is actually a
> > port number and not a string or a number; similar for the HOST
> > argument.
> >
> I don't think this is necessary, so I'll leave that for a future
> enhancement. To restrict connections to the local host, I suggest
> using either "localhost" for the HOST or as local (UNIX) socket.
It was indented to implement protocols like DCC. But it is better to
leave this for the feature.
> Ok, but as you mention yourself, this is the exception, so it
> shouldn't be the standard behaviour. I will take a look at using
> stop-process and start-process to temporarily inhibit a server socket
> from accepting connections. If you can use stop-process in
> the sentinel, this seems to be a cleaner solution than
> having to (re-)enable the server by calling accept-connection.
OK. I will not bother you again :-)
Thanks for all your work, Kim.
Helmut.
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-07 0:08 ` New patch for server sockets and datagram (UDP) support Kim F. Storm
2002-03-07 10:56 ` Kim F. Storm
2002-03-07 12:54 ` Mario Lang
@ 2002-03-08 9:09 ` Richard Stallman
2002-03-08 9:35 ` Kim F. Storm
2002-03-08 11:04 ` Helmut Eller
2 siblings, 2 replies; 46+ messages in thread
From: Richard Stallman @ 2002-03-08 9:09 UTC (permalink / raw)
Cc: emacs-devel, helmut
Helmut, what do you think of this approach? Does it solve the problems
you were concerned about?
Given that datagram streams are handled so differently at the user
level, would it be better to have a different function to open one?
+ DEFVAR_LISP ("network-server-log-function", &Vnetwork_server_log_function,
+ doc: /* Function called when accepting a network connecting.
+ Arguments are SERVER, PROCESS, and MESSAGE, where SERVER is the server process,
+ PROCESS is the new process for the connection, and MESSAGE is a string. */);
Could you please explain more about this? I am wondering whether
having a single function to be called for all connections is the right
interface for the job.
For consistency, please have two separate functions
process-datagram-address and set-process-datagram-address.
The former should just return the current status; the latter
should set it, like the other set-process-... functions.
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-08 7:38 ` Helmut Eller
@ 2002-03-08 9:13 ` Kim F. Storm
2002-03-08 11:16 ` Helmut Eller
2002-03-08 16:36 ` Stefan Monnier
2002-03-08 21:07 ` Richard Stallman
1 sibling, 2 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-03-08 9:13 UTC (permalink / raw)
Cc: emacs-devel
Helmut Eller <helmut@xaital.km4u.net> writes:
> storm@cua.dk (Kim F. Storm) writes:
>
>
> > :nowait BOOL -- Don't wait for client process to complete the
> > connection to the server if BOOL is non-nil; instead, the sentinel
> > function will be called with second matching "open" (if successful) or
> > "failed" when the connect completes. Default is to use a blocking
> > connect.
>
> I would prefer :wait that defaults to t. Is shorter and avoids the
> negation.
Since we will normally use this through wrappers -- and there is
really only one usage which does actually wait (corresponsing to the
old, blocking open-network-stream), it makes more sense to have a
:wait key with default nil. I'll change that.
>
> > Notice that the FILTER and SENTINEL args are never used directly by
> > the server process. Also, the BUFFER argument is not used directly by
> > the server process, but via `network-server-log-function' hook, a log
> > of the accepted (and failed) connections may be recorded in the server
> > process' buffer.
>
> network-server-log-function is a global variable. This may cause
> problems when used by independent packages. Is it a problem to make
> this an attribute of the server process? E.g. as :log-function
> argument?
>
I actually didn't expect any `packages' as such to use this, as I just
intended it to be a way to trace/debug connectivity problems.
But I agree that it would be cleaner to add it per-connection
via a :log argument. I'll think about that...
> > The following special call returns t iff a given KEY VALUE
> > pair is supported on this system:
> > (make-network-process :feature KEY VALUE) */)
>
> Hmm... this looks a bit strange. Can you give some examples?
> Especially, what do you supply as VALUE?
>
It simply tests whether using KEY VALUE as arguments to make-network-stream
is supported, e.g. :datagram t, :nowait t, :family 'local.
> > > Because there is currently no way to get the IP address(es) of the
> > > current host. It MAY also simplify the C level implementation,
> > > because you could require that e.g. the SERVICE argument is actually a
> > > port number and not a string or a number; similar for the HOST
> > > argument.
> > >
> > I don't think this is necessary, so I'll leave that for a future
> > enhancement. To restrict connections to the local host, I suggest
> > using either "localhost" for the HOST or as local (UNIX) socket.
>
> It was indented to implement protocols like DCC. But it is better to
> leave this for the feature.
Yes! I think I'm trying to cope with enough new functionality here :-)
>
> > Ok, but as you mention yourself, this is the exception, so it
> > shouldn't be the standard behaviour. I will take a look at using
> > stop-process and start-process to temporarily inhibit a server socket
> > from accepting connections. If you can use stop-process in
> > the sentinel, this seems to be a cleaner solution than
> > having to (re-)enable the server by calling accept-connection.
>
> OK. I will not bother you again :-)
Actually, I will make `:wait t' work for a server socket -- that
will allow you to start the server in the stopped state.
>
> Thanks for all your work, Kim.
Thank you for your initial work on this, as well as your valuable
feedback, Helmut!
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-08 9:09 ` Richard Stallman
@ 2002-03-08 9:35 ` Kim F. Storm
2002-03-08 11:04 ` Helmut Eller
1 sibling, 0 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-03-08 9:35 UTC (permalink / raw)
Cc: helmut
Richard Stallman <rms@gnu.org> writes:
>
> Given that datagram streams are handled so differently at the user
> level, would it be better to have a different function to open one?
>
I think my latest proposal for `make-network-process' with wrappers
functions like open-datagram-client addresses this concern.
>
> + DEFVAR_LISP ("network-server-log-function", &Vnetwork_server_log_function,
> + doc: /* Function called when accepting a network connecting.
> + Arguments are SERVER, PROCESS, and MESSAGE, where SERVER is the server process,
> + PROCESS is the new process for the connection, and MESSAGE is a string. */);
>
> Could you please explain more about this? I am wondering whether
> having a single function to be called for all connections is the right
> interface for the job.
>
Helmut suggested that I do this on a per-server basis; I'll look into that.
>
> For consistency, please have two separate functions
> process-datagram-address and set-process-datagram-address.
> The former should just return the current status; the latter
> should set it, like the other set-process-... functions.
>
Ok, I will do that.
The reason I made just one function is that I was concerned whether
doing
(setq old-address (process-datagram-address P))
(set-process-datagram-address P new-address)
in two steps would be atomic. But since we don't
accept input between those two, they will be atomic.
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-08 9:09 ` Richard Stallman
2002-03-08 9:35 ` Kim F. Storm
@ 2002-03-08 11:04 ` Helmut Eller
1 sibling, 0 replies; 46+ messages in thread
From: Helmut Eller @ 2002-03-08 11:04 UTC (permalink / raw)
Cc: storm, emacs-devel
Richard Stallman <rms@gnu.org> writes:
> Helmut, what do you think of this approach? Does it solve the problems
> you were concerned about?
I'm happy with the new `make-network-process' function.
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-08 9:13 ` Kim F. Storm
@ 2002-03-08 11:16 ` Helmut Eller
2002-03-08 16:36 ` Stefan Monnier
1 sibling, 0 replies; 46+ messages in thread
From: Helmut Eller @ 2002-03-08 11:16 UTC (permalink / raw)
Cc: emacs-devel
storm@cua.dk (Kim F. Storm) writes:
> It simply tests whether using KEY VALUE as arguments to make-network-stream
> is supported, e.g. :datagram t, :nowait t, :family 'local.
I would prefer the approach with featurep, e.g. (featurep
'datagram-sockets), (featurep 'unix-sockets). It's not so clear how
the VALUE argument should be compared (eq, or equal, etc). The user
would have to know how to test for a specific feature anyway.
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-08 9:13 ` Kim F. Storm
2002-03-08 11:16 ` Helmut Eller
@ 2002-03-08 16:36 ` Stefan Monnier
2002-03-08 20:57 ` Kim F. Storm
1 sibling, 1 reply; 46+ messages in thread
From: Stefan Monnier @ 2002-03-08 16:36 UTC (permalink / raw)
Cc: Helmut Eller, emacs-devel
> > > The following special call returns t iff a given KEY VALUE
> > > pair is supported on this system:
> > > (make-network-process :feature KEY VALUE) */)
> >
> > Hmm... this looks a bit strange. Can you give some examples?
> > Especially, what do you supply as VALUE?
> >
>
> It simply tests whether using KEY VALUE as arguments to make-network-stream
> is supported, e.g. :datagram t, :nowait t, :family 'local.
I suggest to use `subfeatures' for that:
(provide 'network '(:datagram :nowait :family ...))
so you can then check
(featurep 'network :datagram)
-- Stefan
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-08 16:36 ` Stefan Monnier
@ 2002-03-08 20:57 ` Kim F. Storm
2002-03-08 21:03 ` Stefan Monnier
0 siblings, 1 reply; 46+ messages in thread
From: Kim F. Storm @ 2002-03-08 20:57 UTC (permalink / raw)
Cc: Helmut Eller, emacs-devel
"Stefan Monnier" <monnier+gnu/emacs@rum.cs.yale.edu> writes:
> > > > The following special call returns t iff a given KEY VALUE
> > > > pair is supported on this system:
> > > > (make-network-process :feature KEY VALUE) */)
> > >
> > > Hmm... this looks a bit strange. Can you give some examples?
> > > Especially, what do you supply as VALUE?
> > >
> >
> > It simply tests whether using KEY VALUE as arguments to make-network-stream
> > is supported, e.g. :datagram t, :nowait t, :family 'local.
>
> I suggest to use `subfeatures' for that:
>
> (provide 'network '(:datagram :nowait :family ...))
I don't want to invent something new here if it isn't needed, but the
problem here is that the proper setings here are determined at
compile-time, so it's not just a question of putting a (provide...)
line somewhere in a lisp file -- since that information is not
available to lisp [that's why I provided the :feature interface].
>
> so you can then check
>
> (featurep 'network :datagram)
>
But how do you test for availability of :family 'local ?
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-08 20:57 ` Kim F. Storm
@ 2002-03-08 21:03 ` Stefan Monnier
0 siblings, 0 replies; 46+ messages in thread
From: Stefan Monnier @ 2002-03-08 21:03 UTC (permalink / raw)
Cc: Stefan Monnier, Helmut Eller, emacs-devel
> "Stefan Monnier" <monnier+gnu/emacs@rum.cs.yale.edu> writes:
>
> > > > > The following special call returns t iff a given KEY VALUE
> > > > > pair is supported on this system:
> > > > > (make-network-process :feature KEY VALUE) */)
> > > >
> > > > Hmm... this looks a bit strange. Can you give some examples?
> > > > Especially, what do you supply as VALUE?
> > > >
> > >
> > > It simply tests whether using KEY VALUE as arguments to make-network-stream
> > > is supported, e.g. :datagram t, :nowait t, :family 'local.
> >
> > I suggest to use `subfeatures' for that:
> >
> > (provide 'network '(:datagram :nowait :family ...))
>
> I don't want to invent something new here if it isn't needed, but the
> problem here is that the proper setings here are determined at
> compile-time, so it's not just a question of putting a (provide...)
> line somewhere in a lisp file -- since that information is not
> available to lisp [that's why I provided the :feature interface].
Then put the call to `feature' in the C code.
> > so you can then check
> >
> > (featurep 'network :datagram)
> >
> But how do you test for availability of :family 'local ?
Whichever way you feel like, e.g. (featurep 'network :family:local).
I guess I just don't understand the question. Also, it's often
good enough to just call make-network-process and see if it succeeds.
You only really need to provide/use `featurep' in order to know whether
something would be ignored or not.
Stefan
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-07 12:39 ` Kim F. Storm
2002-03-07 14:51 ` Alex Schroeder
@ 2002-03-08 21:06 ` Richard Stallman
2002-03-13 15:56 ` Kim F. Storm
1 sibling, 1 reply; 46+ messages in thread
From: Richard Stallman @ 2002-03-08 21:06 UTC (permalink / raw)
Cc: alex, emacs-devel
We could rename the C-level function to, say, open-network-connection
and write lisp-level wrappers (in simple.el) around it like
open-network-stream, open-network-stream-nowait, open-network-stream-server,
open-local-stream-nowait, open-local-stream, open-local-stream-server,
open-datagram-server, open-datagram-client,
etc. etc.
That is taking things to an absurd extreme. We certainly do not want
to define all these as separate functions--it would be cumbersome.
However, to have two or three convenience or compatibility functions
for a few larger categories of cases could be a good idea.
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-08 7:38 ` Helmut Eller
2002-03-08 9:13 ` Kim F. Storm
@ 2002-03-08 21:07 ` Richard Stallman
2002-03-13 15:12 ` Kim F. Storm
1 sibling, 1 reply; 46+ messages in thread
From: Richard Stallman @ 2002-03-08 21:07 UTC (permalink / raw)
Cc: storm, emacs-devel
> :nowait BOOL -- Don't wait for client process to complete the
> connection to the server if BOOL is non-nil; instead, the sentinel
> function will be called with second matching "open" (if successful) or
> "failed" when the connect completes. Default is to use a blocking
> connect.
I would prefer :wait that defaults to t. Is shorter and avoids the
negation.
A default that isn't nil, when nil cannot stand for use of the
default, is problematical.
> The following special call returns t iff a given KEY VALUE
> pair is supported on this system:
> (make-network-process :feature KEY VALUE) */)
Hmm... this looks a bit strange. Can you give some examples?
Especially, what do you supply as VALUE?
That usage seems like a kludge to me. What exactly is it trying to
solve? Would it work to simply try this combination of args, catch
the error that you get if it isn't supported, and try another method?
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-08 21:07 ` Richard Stallman
@ 2002-03-13 15:12 ` Kim F. Storm
0 siblings, 0 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-03-13 15:12 UTC (permalink / raw)
Richard Stallman <rms@gnu.org> writes:
>
> > The following special call returns t iff a given KEY VALUE
> > pair is supported on this system:
> > (make-network-process :feature KEY VALUE) */)
>
> Hmm... this looks a bit strange. Can you give some examples?
> Especially, what do you supply as VALUE?
>
> That usage seems like a kludge to me. What exactly is it trying to
> solve? Would it work to simply try this combination of args, catch
> the error that you get if it isn't supported, and try another method?
Well, there are many combinations of things that may or may not work.
This provides a simple way to check in advance whether a given
feature is _supposed_ to work on this system. If it then fails,
something more fundamental is wrong.
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: New patch for server sockets and datagram (UDP) support.
2002-03-08 21:06 ` Richard Stallman
@ 2002-03-13 15:56 ` Kim F. Storm
2002-03-13 23:19 ` Final(?) " Kim F. Storm
0 siblings, 1 reply; 46+ messages in thread
From: Kim F. Storm @ 2002-03-13 15:56 UTC (permalink / raw)
Richard Stallman <rms@gnu.org> writes:
> We could rename the C-level function to, say, open-network-connection
> and write lisp-level wrappers (in simple.el) around it like
> open-network-stream, open-network-stream-nowait, open-network-stream-server,
> open-local-stream-nowait, open-local-stream, open-local-stream-server,
> open-datagram-server, open-datagram-client,
> etc. etc.
>
> That is taking things to an absurd extreme. We certainly do not want
> to define all these as separate functions--it would be cumbersome.
I agree.
>
> However, to have two or three convenience or compatibility functions
> for a few larger categories of cases could be a good idea.
In the patch I'll send out later today, only three such functions are
defined:
open-network-stream
open-network-stream-nowait
open-network-stream-server
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Final(?) patch for server sockets and datagram (UDP) support.
2002-03-13 15:56 ` Kim F. Storm
@ 2002-03-13 23:19 ` Kim F. Storm
2002-03-14 0:50 ` Al Petrofsky
2002-03-17 22:02 ` I have installed the " Kim F. Storm
0 siblings, 2 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-03-13 23:19 UTC (permalink / raw)
Cc: helmut
The following (large) patch encompasses the majority of the
requirements raised by people for enhancements to the networking
support in emacs: server sockets, datagrams, local (unix) sockets.
I still need to add checks for sendto, recvfrom, and getsockname to
configure.in/configure. I'll do that eventually, but until then, the
patch explicitly defines these for GNU_LINUX.
Updates to the Elisp manual are also missing (of course :-)
Index: etc/NEWS
===================================================================
RCS file: /cvs/emacs/etc/NEWS,v
retrieving revision 1.624
diff -c -r1.624 NEWS
*** etc/NEWS 13 Mar 2002 09:34:06 -0000 1.624
--- etc/NEWS 13 Mar 2002 23:13:57 -0000
***************
*** 654,671 ****
change group you start for any given buffer should be the last one
finished.
! ** You can now use non-blocking connect to open network streams.
! The function open-network-stream has a new optional 7th argument.
! If non-nil, that function will initiate a non-blocking connect and
! return immediately before the connection is established.
!
! It returns nil if the system does not support non-blocking connects;
! the caller may then make a normal (blocking) open-network-stream.
!
! The filter and sentinel functions can now be specified as arguments
! to open-network-stream. When the non-blocking connect completes, the
! sentinel is called with the status matching "open" or "failed".
** New function substring-no-properties.
--- 654,705 ----
change group you start for any given buffer should be the last one
finished.
! ** Enhanced networking support.
! *** There is a new `make-network-process' function which supports
! opening of stream and datagram connections to a server, as well as
! create a stream or datagram server inside emacs.
!
! - A server is started using :server t arg.
! - Datagram connection is selected using :datagram t arg.
! - A server can open on a random port using :service t arg.
! - Local sockets are supported using :family 'local arg.
! - Non-blocking connect is supported using :nowait t arg.
!
! *** Original open-network-stream is now emulated using make-network-process.
!
! *** New function open-network-stream-nowait.
!
! This function initiates a non-blocking connect and returns immediately
! before the connection is established. The filter and sentinel
! functions can be specified as arguments to open-network-stream-nowait.
! When the non-blocking connect completes, the sentinel is called with
! the status matching "open" or "failed".
!
! *** New function open-network-stream-server.
!
! *** New functions process-datagram-address and set-process-datagram-address.
!
! *** By default, the function process-contact still returns (HOST SERVICE)
! for a network process. Using the new optional KEY arg, the complete list
! of network process properties or a specific property can be selected.
!
! Using :local and :remote as the KEY, the address of the local or
! remote end-point is returned. An Inet address is represented as a 5
! element vector, where the first 4 elements contain the IP address and
! the fifth is the port number.
!
! *** Network processes can now be stopped and restarted with
! `stop-process' and `continue-process'. For a server process, no
! connections are accepted in the stopped state. For a client process,
! no input is received in the stopped state.
!
! *** Function list-processes now has an optional argument; if non-nil,
! only the processes whose query-on-exit flag is set are listed.
!
! *** New set-process-query-on-exit-flag and process-query-on-exit-flag
! functions. The existing process-kill-without-query function is still
! supported, but new code should use the new functions.
** New function substring-no-properties.
Index: src/ChangeLog
===================================================================
RCS file: /cvs/emacs/src/ChangeLog,v
retrieving revision 1.2520
diff -c -r1.2520 ChangeLog
*** src/ChangeLog 13 Mar 2002 17:07:45 -0000 1.2520
--- src/ChangeLog 13 Mar 2002 23:13:58 -0000
***************
*** 1,3 ****
--- 1,60 ----
+ 2002-03-13 Kim F. Storm <storm@cua.dk>
+
+ The following changes adds support for network server processes,
+ datagram connections, and local (unix) sockets.
+
+ * process.h (struct Lisp_Process): New member log.
+ Doc fix: Member command used to indicate stopped network process.
+ Doc fix: Member childp contains plist for network process.
+ Doc fix: Member kill_without_query is inverse of query-on-exit flag.
+
+ * process.c (Qlocal, QCname, QCbuffer, QChost, QCservice, QCfamily)
+ (QClocal, QCremote, QCserver, QCdatagram, QCnowait, QCnoquery)
+ (QCstop, QCfilter, QCsentinel, QClog, QCfeature): New variables.
+ (NETCONN1_P): New macro.
+ (DATAGRAM_SOCKETS): New conditional symbol.
+ (datagram_address): New array.
+ (DATAGRAM_CONN_P, DATAGRAM_CHAN_P): New macros.
+ (status_message): Use concat3.
+ (Fprocess_status): Add `listen' status to doc string. Return `stop'
+ for a stopped network process.
+ (Fset_process_buffer): Update contact plist for network process.
+ (Fset_process_filter): Ditto. Don't enable input for stopped
+ network processes. Server must listen, even if filter is t.
+ (Fset_process_query_on_exit_flag, Fprocess_query_on_exit_flag):
+ New functions.
+ (Fprocess_kill_without_query): Removed. Now defined in simple.el.
+ (Fprocess_contact): Added KEY argument. Handle datagrams.
+ (list_processes_1): Optionally show only processes with the query
+ on exit flag set. Dynamically adjust column widths. Omit tty
+ column if not needed. Report stopped network processes.
+ Identify server and datagram network processes.
+ (Flist_processes): New optional arg `query-only'.
+ (conv_sockaddr_to_lisp, get_lisp_to_sockaddr_size)
+ (conv_lisp_to_sockaddr): New helper functions.
+ (Fprocess_datagram_address, Fset_process_datagram_address):
+ New lisp functions.
+ (network_process_featurep, unwind_request_sigio): New helper functions.
+ (Fopen_network_stream): Removed. Now defined in simple.el.
+ (Fmake_network_process): New lisp function. Code is based on previous
+ Fopen_network_stream, but heavily reworked with new property list based
+ argument list, support for datagrams, server processes, and local
+ sockets in addition to old client-only functionality.
+ (server_accept_connection): New function.
+ (wait_reading_process_input): Use it to handle incoming connects.
+ Do not enable input on a new connection if process is stopped.
+ (read_process_output): Handle datagram sockets. Use 2k buffer for them.
+ (send_process): Handle datagram sockets.
+ (Fstop_process, Fcontinue_process): Apply to network processes. A stopped
+ network process is indicated by setting command field to t .
+ (Fprocess_send_eof): No-op if datagram connection.
+ (Fstatus_notify): Don't read input for a stream server socket or a
+ stopped network process.
+ (init_process): Initialize datagram_address array.
+ (syms_of_process): Intern and staticpro new variables, defsubr new
+ functions.
+
+
2002-03-13 Stefan Monnier <monnier@cs.yale.edu>
* xterm.c (x_set_toolkit_scroll_bar_thumb) <USE_MOTIF>:
Index: src/process.h
===================================================================
RCS file: /cvs/emacs/src/process.h,v
retrieving revision 1.18
diff -c -r1.18 process.h
*** src/process.h 14 Oct 2001 20:14:49 -0000 1.18
--- src/process.h 13 Mar 2002 23:13:58 -0000
***************
*** 40,52 ****
Lisp_Object tty_name;
/* Name of this process */
Lisp_Object name;
! /* List of command arguments that this process was run with */
Lisp_Object command;
/* (funcall FILTER PROC STRING) (if FILTER is non-nil)
to dispose of a bunch of chars from the process all at once */
Lisp_Object filter;
/* (funcall SENTINEL PROCESS) when process state changes */
Lisp_Object sentinel;
/* Buffer that output is going to */
Lisp_Object buffer;
/* Number of this process */
--- 40,56 ----
Lisp_Object tty_name;
/* Name of this process */
Lisp_Object name;
! /* List of command arguments that this process was run with.
! Is set to t for a stopped network process; nil otherwise. */
Lisp_Object command;
/* (funcall FILTER PROC STRING) (if FILTER is non-nil)
to dispose of a bunch of chars from the process all at once */
Lisp_Object filter;
/* (funcall SENTINEL PROCESS) when process state changes */
Lisp_Object sentinel;
+ /* (funcall LOG SERVER CLIENT MESSAGE) when a server process
+ accepts a connection from a client. */
+ Lisp_Object log;
/* Buffer that output is going to */
Lisp_Object buffer;
/* Number of this process */
***************
*** 54,64 ****
/* Non-nil if this is really a command channel */
Lisp_Object command_channel_p;
/* t if this is a real child process.
! For a net connection, it is (HOST SERVICE). */
Lisp_Object childp;
/* Marker set to end of last buffer-inserted output from this process */
Lisp_Object mark;
! /* Non-nil means kill silently if Emacs is exited. */
Lisp_Object kill_without_query;
/* Record the process status in the raw form in which it comes from `wait'.
This is to avoid consing in a signal handler. */
--- 58,69 ----
/* Non-nil if this is really a command channel */
Lisp_Object command_channel_p;
/* t if this is a real child process.
! For a net connection, it is a plist based on the arguments to make-network-process. */
Lisp_Object childp;
/* Marker set to end of last buffer-inserted output from this process */
Lisp_Object mark;
! /* Non-nil means kill silently if Emacs is exited.
! This is the inverse of the `query-on-exit' flag. */
Lisp_Object kill_without_query;
/* Record the process status in the raw form in which it comes from `wait'.
This is to avoid consing in a signal handler. */
Index: src/process.c
===================================================================
RCS file: /cvs/emacs/src/process.c,v
retrieving revision 1.355
diff -c -r1.355 process.c
*** src/process.c 3 Mar 2002 00:31:22 -0000 1.355
--- src/process.c 13 Mar 2002 23:14:00 -0000
***************
*** 54,59 ****
--- 54,67 ----
#include <netdb.h>
#include <netinet/in.h>
#include <arpa/inet.h>
+ #ifndef AF_LOCAL
+ #ifdef AF_UNIX
+ #define AF_LOCAL AF_UNIX
+ #endif
+ #endif
+ #ifdef AF_LOCAL
+ #include <sys/un.h>
+ #endif
#ifdef NEED_NET_ERRNO_H
#include <net/errno.h>
#endif /* NEED_NET_ERRNO_H */
***************
*** 113,119 ****
Lisp_Object Qprocessp;
Lisp_Object Qrun, Qstop, Qsignal;
! Lisp_Object Qopen, Qclosed, Qconnect, Qfailed;
Lisp_Object Qlast_nonmenu_event;
/* Qexit is declared and initialized in eval.c. */
--- 121,132 ----
Lisp_Object Qprocessp;
Lisp_Object Qrun, Qstop, Qsignal;
! Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
! Lisp_Object Qlocal;
! Lisp_Object QCname, QCbuffer, QChost, QCservice, QCfamily;
! Lisp_Object QClocal, QCremote;
! Lisp_Object QCserver, QCdatagram, QCnowait, QCnoquery, QCstop;
! Lisp_Object QCfilter, QCsentinel, QClog, QCfeature;
Lisp_Object Qlast_nonmenu_event;
/* Qexit is declared and initialized in eval.c. */
***************
*** 122,129 ****
--- 135,144 ----
#ifdef HAVE_SOCKETS
#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
+ #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
#else
#define NETCONN_P(p) 0
+ #define NETCONN1_P(p) 0
#endif /* HAVE_SOCKETS */
/* Define first descriptor number available for subprocesses. */
***************
*** 194,203 ****
--- 209,247 ----
#endif /* NON_BLOCKING_CONNECT */
#endif /* BROKEN_NON_BLOCKING_CONNECT */
+ /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
+ this system. We need to read full packets, so we need a
+ "non-destructive" select. So we require either native select,
+ or emulation of select using FIONREAD. */
+
+ #ifdef GNU_LINUX
+ /* These are not yet in configure.in (they will be eventually)
+ -- so add them here temporarily. ++kfs */
+ #define HAVE_RECVFROM
+ #define HAVE_SENDTO
+ #define HAVE_GETSOCKNAME
+ #endif
+
+ #ifdef BROKEN_DATAGRAM_SOCKETS
+ #undef DATAGRAM_SOCKETS
+ #else
+ #ifndef DATAGRAM_SOCKETS
+ #ifdef HAVE_SOCKETS
+ #if defined (HAVE_SELECT) || defined (FIONREAD)
+ #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
+ #define DATAGRAM_SOCKETS
+ #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
+ #endif /* HAVE_SELECT || FIONREAD */
+ #endif /* HAVE_SOCKETS */
+ #endif /* DATAGRAM_SOCKETS */
+ #endif /* BROKEN_DATAGRAM_SOCKETS */
+
#ifdef TERM
#undef NON_BLOCKING_CONNECT
+ #undef DATAGRAM_SOCKETS
#endif
+
#include "sysselect.h"
extern int keyboard_bit_set P_ ((SELECT_TYPE *));
***************
*** 257,262 ****
--- 301,319 ----
static struct coding_system *proc_decode_coding_system[MAXDESC];
static struct coding_system *proc_encode_coding_system[MAXDESC];
+ #ifdef DATAGRAM_SOCKETS
+ /* Table of `partner address' for datagram sockets. */
+ struct sockaddr_and_len {
+ struct sockaddr *sa;
+ int len;
+ } datagram_address[MAXDESC];
+ #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
+ #define DATAGRAM_CONN_P(proc) (datagram_address[XPROCESS (proc)->infd].sa != 0)
+ #else
+ #define DATAGRAM_CHAN_P(chan) (0)
+ #define DATAGRAM_CONN_P(proc) (0)
+ #endif
+
static Lisp_Object get_process ();
static void exec_sentinel ();
***************
*** 367,381 ****
return build_string ("finished\n");
string = Fnumber_to_string (make_number (code));
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
! return concat2 (build_string ("exited abnormally with code "),
! concat2 (string, string2));
}
else if (EQ (symbol, Qfailed))
{
string = Fnumber_to_string (make_number (code));
string2 = build_string ("\n");
! return concat2 (build_string ("failed with code "),
! concat2 (string, string2));
}
else
return Fcopy_sequence (Fsymbol_name (symbol));
--- 424,438 ----
return build_string ("finished\n");
string = Fnumber_to_string (make_number (code));
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
! return concat3 (build_string ("exited abnormally with code "),
! string, string2);
}
else if (EQ (symbol, Qfailed))
{
string = Fnumber_to_string (make_number (code));
string2 = build_string ("\n");
! return concat3 (build_string ("failed with code "),
! string, string2);
}
else
return Fcopy_sequence (Fsymbol_name (symbol));
***************
*** 635,640 ****
--- 692,698 ----
exit -- for a process that has exited.
signal -- for a process that has got a fatal signal.
open -- for a network stream connection that is open.
+ listen -- for a network stream server that is listening.
closed -- for a network stream connection that is closed.
connect -- when waiting for a non-blocking connection to complete.
failed -- when a non-blocking connection has failed.
***************
*** 661,672 ****
status = p->status;
if (CONSP (status))
status = XCAR (status);
! if (NETCONN_P (process))
{
! if (EQ (status, Qrun))
! status = Qopen;
! else if (EQ (status, Qexit))
status = Qclosed;
}
return status;
}
--- 719,732 ----
status = p->status;
if (CONSP (status))
status = XCAR (status);
! if (NETCONN1_P (p))
{
! if (EQ (status, Qexit))
status = Qclosed;
+ else if (EQ (p->command, Qt))
+ status = Qstop;
+ else if (EQ (status, Qrun))
+ status = Qopen;
}
return status;
}
***************
*** 737,746 ****
(process, buffer)
register Lisp_Object process, buffer;
{
CHECK_PROCESS (process);
if (!NILP (buffer))
CHECK_BUFFER (buffer);
! XPROCESS (process)->buffer = buffer;
return buffer;
}
--- 797,811 ----
(process, buffer)
register Lisp_Object process, buffer;
{
+ struct Lisp_Process *p;
+
CHECK_PROCESS (process);
if (!NILP (buffer))
CHECK_BUFFER (buffer);
! p = XPROCESS (process);
! p->buffer = buffer;
! if (NETCONN1_P (p))
! p->childp = Fplist_put (p->childp, QCbuffer, buffer);
return buffer;
}
***************
*** 791,802 ****
if (XINT (p->infd) >= 0)
{
! if (EQ (filter, Qt))
{
FD_CLR (XINT (p->infd), &input_wait_mask);
FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
}
! else if (EQ (XPROCESS (process)->filter, Qt))
{
FD_SET (XINT (p->infd), &input_wait_mask);
FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
--- 856,868 ----
if (XINT (p->infd) >= 0)
{
! if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
{
FD_CLR (XINT (p->infd), &input_wait_mask);
FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
}
! else if (EQ (p->filter, Qt)
! && !EQ (p->command, Qt)) /* Network process not stopped. */
{
FD_SET (XINT (p->infd), &input_wait_mask);
FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
***************
*** 804,809 ****
--- 870,877 ----
}
p->filter = filter;
+ if (NETCONN1_P (p))
+ p->childp = Fplist_put (p->childp, QCfilter, filter);
return filter;
}
***************
*** 899,930 ****
return XPROCESS (process)->inherit_coding_system_flag;
}
! DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
! Sprocess_kill_without_query, 1, 2, 0,
! doc: /* Say no query needed if PROCESS is running when Emacs is exited.
! Optional second argument if non-nil says to require a query.
! Value is t if a query was formerly required. */)
! (process, value)
! register Lisp_Object process, value;
{
- Lisp_Object tem;
-
CHECK_PROCESS (process);
! tem = XPROCESS (process)->kill_without_query;
! XPROCESS (process)->kill_without_query = Fnull (value);
!
! return Fnull (tem);
}
! DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1, 1, 0,
! doc: /* Return the contact info of PROCESS; t for a real child.
! For a net connection, the value is a cons cell of the form (HOST SERVICE). */)
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
! return XPROCESS (process)->childp;
}
#if 0 /* Turned off because we don't currently record this info
--- 967,1030 ----
return XPROCESS (process)->inherit_coding_system_flag;
}
! DEFUN ("set-process-query-on-exit-flag",
! Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
! 2, 2, 0,
! doc: /* Specify if query is needed for PROCESS when Emacs is exited.
! If the second argument FLAG is non-nil, emacs will query the user before
! exiting if PROCESS is running. */)
! (process, flag)
! register Lisp_Object process, flag;
{
CHECK_PROCESS (process);
! XPROCESS (process)->kill_without_query = Fnull (flag);
! return flag;
}
! DEFUN ("process-query-on-exit-flag",
! Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
1, 1, 0,
! doc: /* Return the current value of query on exit flag for PROCESS. */)
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
! return Fnull (XPROCESS (process)->kill_without_query);
! }
!
! #ifdef DATAGRAM_SOCKETS
! Lisp_Object Fprocess_datagram_address ();
! #endif
!
! DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
! 1, 2, 0,
! doc: /* Return the contact info of PROCESS; t for a real child.
! For a net connection, the value depends on the optional KEY arg.
! If KEY is nil, value is a cons cell of the form (HOST SERVICE),
! if KEY is t, the complete contact information for the connection is
! returned, else the specific value for the keyword KEY is returned.
! See `make-network-process' for a list of keywords. */)
! (process, key)
! register Lisp_Object process, key;
! {
! Lisp_Object contact;
!
! CHECK_PROCESS (process);
! contact = XPROCESS (process)->childp;
!
! #ifdef DATAGRAM_SOCKETS
! if (DATAGRAM_CONN_P (process)
! && (EQ (key, Qt) || EQ (key, QCremote)))
! contact = Fplist_put (contact, QCremote,
! Fprocess_datagram_address (process));
! #endif
!
! if (!NETCONN_P (process) || EQ (key, Qt))
! return contact;
! if (NILP (key))
! return Fcons (Fplist_get (contact, QChost),
! Fcons (Fplist_get (contact, QCservice), Qnil));
! return Fplist_get (contact, key);
}
#if 0 /* Turned off because we don't currently record this info
***************
*** 941,952 ****
#endif
\f
Lisp_Object
! list_processes_1 ()
{
register Lisp_Object tail, tem;
Lisp_Object proc, minspace, tem1;
register struct Lisp_Process *p;
! char tembuf[80];
XSETFASTINT (minspace, 1);
--- 1041,1095 ----
#endif
\f
Lisp_Object
! list_processes_1 (query_only)
! Lisp_Object query_only;
{
register Lisp_Object tail, tem;
Lisp_Object proc, minspace, tem1;
register struct Lisp_Process *p;
! char tembuf[300];
! int w_proc, w_buffer, w_tty;
! Lisp_Object i_status, i_buffer, i_tty, i_command;
!
! w_proc = 4; /* Proc */
! w_buffer = 6; /* Buffer */
! w_tty = 0; /* Omit if no ttys */
!
! for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
! {
! int i;
!
! proc = Fcdr (Fcar (tail));
! p = XPROCESS (proc);
! if (NILP (p->childp))
! continue;
! if (!NILP (query_only) && !NILP (p->kill_without_query))
! continue;
! if (STRINGP (p->name)
! && ( i = XSTRING (p->name)->size, (i > w_proc)))
! w_proc = i;
! if (!NILP (p->buffer))
! {
! if (NILP (XBUFFER (p->buffer)->name) && w_buffer < 8)
! w_buffer = 8; /* (Killed) */
! else if ((i = XSTRING (XBUFFER (p->buffer)->name)->size, (i > w_buffer)))
! w_buffer = i;
! }
! if (STRINGP (p->tty_name)
! && (i = XSTRING (p->tty_name)->size, (i > w_tty)))
! w_tty = i;
! }
!
! XSETFASTINT (i_status, w_proc + 1);
! XSETFASTINT (i_buffer, XFASTINT (i_status) + 9);
! if (w_tty)
! {
! XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1);
! XSETFASTINT (i_command, XFASTINT (i_buffer) + w_tty + 1);
! } else {
! i_tty = Qnil;
! XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1);
! }
XSETFASTINT (minspace, 1);
***************
*** 955,963 ****
current_buffer->truncate_lines = Qt;
! write_string ("\
! Proc Status Buffer Tty Command\n\
! ---- ------ ------ --- -------\n", -1);
for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
{
--- 1098,1122 ----
current_buffer->truncate_lines = Qt;
! write_string ("Proc", -1);
! Findent_to (i_status, minspace); write_string ("Status", -1);
! Findent_to (i_buffer, minspace); write_string ("Buffer", -1);
! if (!NILP (i_tty))
! {
! Findent_to (i_tty, minspace); write_string ("Tty", -1);
! }
! Findent_to (i_command, minspace); write_string ("Command", -1);
! write_string ("\n", -1);
!
! write_string ("----", -1);
! Findent_to (i_status, minspace); write_string ("------", -1);
! Findent_to (i_buffer, minspace); write_string ("------", -1);
! if (!NILP (i_tty))
! {
! Findent_to (i_tty, minspace); write_string ("---", -1);
! }
! Findent_to (i_command, minspace); write_string ("-------", -1);
! write_string ("\n", -1);
for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
{
***************
*** 967,975 ****
p = XPROCESS (proc);
if (NILP (p->childp))
continue;
Finsert (1, &p->name);
! Findent_to (make_number (13), minspace);
if (!NILP (p->raw_status_low))
update_status (p);
--- 1126,1136 ----
p = XPROCESS (proc);
if (NILP (p->childp))
continue;
+ if (!NILP (query_only) && !NILP (p->kill_without_query))
+ continue;
Finsert (1, &p->name);
! Findent_to (i_status, minspace);
if (!NILP (p->raw_status_low))
update_status (p);
***************
*** 989,1000 ****
#endif
Fprinc (symbol, Qnil);
}
! else if (NETCONN_P (proc))
{
! if (EQ (symbol, Qrun))
! write_string ("open", -1);
! else if (EQ (symbol, Qexit))
write_string ("closed", -1);
else
Fprinc (symbol, Qnil);
}
--- 1150,1163 ----
#endif
Fprinc (symbol, Qnil);
}
! else if (NETCONN1_P (p))
{
! if (EQ (symbol, Qexit))
write_string ("closed", -1);
+ else if (EQ (p->command, Qt))
+ write_string ("stopped", -1);
+ else if (EQ (symbol, Qrun))
+ write_string ("open", -1);
else
Fprinc (symbol, Qnil);
}
***************
*** 1015,1021 ****
if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
remove_process (proc);
! Findent_to (make_number (22), minspace);
if (NILP (p->buffer))
insert_string ("(none)");
else if (NILP (XBUFFER (p->buffer)->name))
--- 1178,1184 ----
if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
remove_process (proc);
! Findent_to (i_buffer, minspace);
if (NILP (p->buffer))
insert_string ("(none)");
else if (NILP (XBUFFER (p->buffer)->name))
***************
*** 1023,1041 ****
else
Finsert (1, &XBUFFER (p->buffer)->name);
! Findent_to (make_number (37), minspace);
!
! if (STRINGP (p->tty_name))
! Finsert (1, &p->tty_name);
! else
! insert_string ("(none)");
! Findent_to (make_number (49), minspace);
! if (NETCONN_P (proc))
{
! sprintf (tembuf, "(network stream connection to %s)\n",
! XSTRING (XCAR (p->childp))->data);
insert_string (tembuf);
}
else
--- 1186,1224 ----
else
Finsert (1, &XBUFFER (p->buffer)->name);
! if (!NILP (i_tty))
! {
! Findent_to (i_tty, minspace);
! if (STRINGP (p->tty_name))
! Finsert (1, &p->tty_name);
! }
! Findent_to (i_command, minspace);
! if (EQ (p->status, Qlisten))
! {
! Lisp_Object port = Fplist_get (p->childp, QCservice);
! if (INTEGERP (port))
! port = Fnumber_to_string (port);
! sprintf (tembuf, "(network %s server on %s)\n",
! (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
! XSTRING (port)->data);
! insert_string (tembuf);
! }
! else if (NETCONN1_P (p))
{
! /* For a local socket, there is no host name,
! so display service instead. */
! Lisp_Object host = Fplist_get (p->childp, QChost);
! if (!STRINGP (host))
! {
! host = Fplist_get (p->childp, QCservice);
! if (INTEGERP (host))
! host = Fnumber_to_string (host);
! }
! sprintf (tembuf, "(network %s connection to %s)\n",
! (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
! XSTRING (host)->data);
insert_string (tembuf);
}
else
***************
*** 1056,1069 ****
return Qnil;
}
! DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
doc: /* Display a list of all processes.
Any process listed as exited or signaled is actually eliminated
after the listing is made. */)
! ()
{
internal_with_output_to_temp_buffer ("*Process List*",
! list_processes_1, Qnil);
return Qnil;
}
--- 1239,1255 ----
return Qnil;
}
! DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P",
doc: /* Display a list of all processes.
+ If optional argument QUERY-ONLY is non-nil, only processes with
+ the query-on-exit flag set will be listed.
Any process listed as exited or signaled is actually eliminated
after the listing is made. */)
! (query_only)
! Lisp_Object query_only;
{
internal_with_output_to_temp_buffer ("*Process List*",
! list_processes_1, query_only);
return Qnil;
}
***************
*** 1776,1829 ****
}
#endif /* not VMS */
#ifdef HAVE_SOCKETS
! /* open a TCP network connection to a given HOST/SERVICE. Treated
! exactly like a normal process when reading and writing. Only
differences are in status display and process deletion. A network
connection has no PID; you cannot signal it. All you can do is
! deactivate and close it via delete-process */
!
! DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
! 4, 7, 0,
! doc: /* Open a TCP connection for a service to a host.
! Returns a subprocess-object to represent the connection.
! Returns nil if a non-blocking connect is attempted on a system which
! cannot support that; in that case, the caller should attempt a
! normal connect instead.
Input and output work as for subprocesses; `delete-process' closes it.
! Args are NAME BUFFER HOST SERVICE FILTER SENTINEL NON-BLOCKING.
! NAME is name for process. It is modified if necessary to make it unique.
! BUFFER is the buffer (or buffer-name) to associate with the process.
! Process output goes at end of that buffer, unless you specify
! an output stream or filter function to handle the output.
! BUFFER may be also nil, meaning that this process is not associated
! with any buffer.
! HOST is name of the host to connect to, or its IP address.
! SERVICE is name of the service desired, or an integer specifying a
! port number to connect to.
! FILTER and SENTINEL are optional args specifying the filter and
! sentinel functions associated with the network stream.
! NON-BLOCKING is optional arg requesting an non-blocking connect.
! When non-nil, open-network-stream will return immediately without
! waiting for the connection to be made. Instead, the sentinel function
! will be called with second matching "open" (if successful) or
! "failed" when the connect completes. */)
! (name, buffer, host, service, filter, sentinel, non_blocking)
! Lisp_Object name, buffer, host, service, filter, sentinel, non_blocking;
{
Lisp_Object proc;
#ifdef HAVE_GETADDRINFO
! struct addrinfo hints, *res, *lres;
! char *portstring, portbuf[128];
#else /* HAVE_GETADDRINFO */
- struct sockaddr_in address;
- struct servent *svc_info;
- struct hostent *host_info_ptr, host_info;
- char *(addr_list[2]);
- IN_ADDR numeric_addr;
- int port;
struct _emacs_addrinfo
{
int ai_family;
--- 1962,2360 ----
}
#endif /* not VMS */
+ \f
#ifdef HAVE_SOCKETS
! /* Convert an internal struct sockaddr to a lisp object (vector or string).
! The address family of sa is not included in the result. */
!
! static Lisp_Object
! conv_sockaddr_to_lisp (sa, len)
! struct sockaddr *sa;
! int len;
! {
! Lisp_Object address;
! int i;
! unsigned char *cp;
! register struct Lisp_Vector *p;
!
! switch (sa->sa_family)
! {
! case AF_INET:
! {
! struct sockaddr_in *sin = (struct sockaddr_in *) sa;
! len = sizeof (sin->sin_addr) + 1;
! address = Fmake_vector (make_number (len), Qnil);
! p = XVECTOR (address);
! p->contents[--len] = make_number (ntohs (sin->sin_port));
! cp = (unsigned char *)&sin->sin_addr;
! break;
! }
! #ifdef AF_LOCAL
! case AF_LOCAL:
! {
! struct sockaddr_un *sun = (struct sockaddr_un *) sa;
! for (i = 0; i < sizeof (sun->sun_path); i++)
! if (sun->sun_path[i] == 0)
! break;
! return make_unibyte_string (sun->sun_path, i);
! }
! #endif
! default:
! len -= sizeof (sa->sa_family);
! address = Fcons (make_number (sa->sa_family),
! Fmake_vector (make_number (len), Qnil));
! p = XVECTOR (XCDR (address));
! cp = (unsigned char *) sa + sizeof (sa->sa_family);
! break;
! }
!
! i = 0;
! while (i < len)
! p->contents[i++] = make_number (*cp++);
!
! return address;
! }
!
!
! /* Get family and required size for sockaddr structure to hold ADDRESS. */
!
! static int
! get_lisp_to_sockaddr_size (address, familyp)
! Lisp_Object address;
! int *familyp;
! {
! register struct Lisp_Vector *p;
!
! if (VECTORP (address))
! {
! p = XVECTOR (address);
! if (p->size == 5)
! {
! *familyp = AF_INET;
! return sizeof (struct sockaddr_in);
! }
! }
! #ifdef AF_LOCAL
! else if (STRINGP (address))
! {
! *familyp = AF_LOCAL;
! return sizeof (struct sockaddr_un);
! }
! #endif
! else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address)))
! {
! struct sockaddr *sa;
! *familyp = XINT (XCAR (address));
! p = XVECTOR (XCDR (address));
! return p->size + sizeof (sa->sa_family);
! }
! return 0;
! }
!
! /* Convert an address object (vector or string) to an internal sockaddr.
! Format of address has already been validated by size_lisp_to_sockaddr. */
!
! static void
! conv_lisp_to_sockaddr (family, address, sa, len)
! int family;
! Lisp_Object address;
! struct sockaddr *sa;
! int len;
! {
! register struct Lisp_Vector *p;
! register unsigned char *cp;
! register int i;
!
! bzero (sa, len);
! sa->sa_family = family;
!
! if (VECTORP (address))
! {
! p = XVECTOR (address);
! if (family == AF_INET)
! {
! struct sockaddr_in *sin = (struct sockaddr_in *) sa;
! len = sizeof (sin->sin_addr) + 1;
! i = XINT (p->contents[--len]);
! sin->sin_port = htons (i);
! cp = (unsigned char *)&sin->sin_addr;
! }
! }
! else if (STRINGP (address))
! {
! #ifdef AF_LOCAL
! if (family == AF_LOCAL)
! {
! struct sockaddr_un *sun = (struct sockaddr_un *) sa;
! cp = XSTRING (address)->data;
! for (i = 0; i < sizeof (sun->sun_path) && *cp; i++)
! sun->sun_path[i] = *cp++;
! }
! #endif
! return;
! }
! else
! {
! p = XVECTOR (XCDR (address));
! cp = (unsigned char *)sa + sizeof (sa->sa_family);
! }
!
! for (i = 0; i < len; i++)
! if (INTEGERP (p->contents[i]))
! *cp++ = XFASTINT (p->contents[i]) & 0xff;
! }
!
! #ifdef DATAGRAM_SOCKETS
! DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
! 1, 1, 0,
! doc: /* Get the current datagram address associated with PROCESS. */)
! (process)
! Lisp_Object process;
! {
! int channel;
!
! CHECK_PROCESS (process);
!
! if (!DATAGRAM_CONN_P (process))
! return Qnil;
!
! channel = XPROCESS (process)->infd;
! return conv_sockaddr_to_lisp (datagram_address[channel].sa,
! datagram_address[channel].len);
! }
!
! DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
! 2, 2, 0,
! doc: /* Set the datagram address for PROCESS to ADDRESS.
! Returns nil upon error setting address, ADDRESS otherwise. */)
! (process, address)
! Lisp_Object process, address;
! {
! int channel;
! int family, len;
!
! CHECK_PROCESS (process);
!
! if (!DATAGRAM_CONN_P (process))
! return Qnil;
!
! channel = XPROCESS (process)->infd;
!
! len = get_lisp_to_sockaddr_size (address, &family);
! if (datagram_address[channel].len != len)
! return Qnil;
! conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
! return address;
! }
! #endif
! \f
! /* Check whether a given KEY VALUE pair is supported on this system. */
!
! static int
! network_process_featurep (key, value)
! Lisp_Object key, value;
! {
!
! if (EQ (key, QCnowait))
! {
! #ifdef NON_BLOCKING_CONNECT
! return 1;
! #else
! return NILP (value);
! #endif
! }
!
! if (EQ (key, QCdatagram))
! {
! #ifdef DATAGRAM_SOCKETS
! return 1;
! #else
! return NILP (value);
! #endif
! }
!
! if (EQ (key, QCfamily))
! {
! if (NILP (value))
! return 1;
! #ifdef AF_LOCAL
! if (EQ (key, Qlocal))
! return 1;
! #endif
! return 0;
! }
!
! if (EQ (key, QCname))
! return STRINGP (value);
!
! if (EQ (key, QCbuffer))
! return (NILP (value) || STRINGP (value) || BUFFERP (value));
!
! if (EQ (key, QClocal) || EQ (key, QCremote))
! {
! int family;
! return get_lisp_to_sockaddr_size (value, &family);
! }
!
! if (EQ (key, QChost))
! return (NILP (value) || STRINGP (value));
!
! if (EQ (key, QCservice))
! {
! #ifdef HAVE_GETSOCKNAME
! if (EQ (value, Qt))
! return 1;
! #endif
! return (INTEGERP (value) || STRINGP (value));
! }
!
! if (EQ (key, QCserver))
! {
! #ifndef TERM
! return 1;
! #else
! return NILP (value);
! #endif
! }
!
! if (EQ (key, QCsentinel))
! return 1;
! if (EQ (key, QCfilter))
! return 1;
! if (EQ (key, QClog))
! return 1;
! if (EQ (key, QCnoquery))
! return 1;
! if (EQ (key, QCstop))
! return 1;
!
! return 0;
! }
!
! /* A version of request_sigio suitable for a record_unwind_protect. */
!
! Lisp_Object
! unwind_request_sigio (dummy)
! Lisp_Object dummy;
! {
! if (interrupt_input)
! request_sigio ();
! return Qnil;
! }
!
! /* Create a network stream/datagram client/server process. Treated
! exactly like a normal process when reading and writing. Primary
differences are in status display and process deletion. A network
connection has no PID; you cannot signal it. All you can do is
! stop/continue it and deactivate/close it via delete-process */
+ DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
+ 0, MANY, 0,
+ doc: /* Create and return a network server or client process.
Input and output work as for subprocesses; `delete-process' closes it.
!
! Arguments are specified as keyword/argument pairs. The following
! arguments are defined:
!
! :name NAME -- NAME is name for process. It is modified if necessary
! to make it unique.
!
! :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
! with the process. Process output goes at end of that buffer, unless
! you specify an output stream or filter function to handle the output.
! BUFFER may be also nil, meaning that this process is not associated
! with any buffer.
!
! :host HOST -- HOST is name of the host to connect to, or its IP
! address. If specified for a server process, only clients on that host
! may connect. The symbol `local' specifies the local host.
!
! :service SERVICE -- SERVICE is name of the service desired, or an
! integer specifying a port number to connect to. If SERVICE is t,
! a random port number is selected for the server.
!
! :local ADDRESS -- ADDRESS is the local address used for the
! connection. This parameter is ignored when opening a client process.
! When specified for a server process, the HOST and SERVICE are ignored.
!
! :remote ADDRESS -- ADDRESS is the remote partner's address for the
! connection. This parameter is ignored when opening a server process.
! When specified for a client process, the HOST and SERVICE are ignored.
!
! :family FAMILY -- FAMILY is the address (and protocol) family for the
! service specified by HOST and SERVICE. The default address family is
! Inet (or IPv4) for the host and port number specified by HOST and
! SERVICE. Other address families supported are:
! local -- for a local (i.e. UNIX) address specified by SERVICE.
!
! :datagram BOOL -- Create a datagram type connection if BOOL is
! non-nil. Default is a stream type connection.
!
! :nowait BOOL -- If BOOL is non-nil for a stream type client process,
! return without waiting for the connection to complete; instead, the
! sentinel function will be called with second arg matching "open" (if
! successful) or "failed" when the connect completes. Default is to use
! a blocking connect (i.e. wait) for stream type connections.
!
! :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
! running when emacs is exited.
!
! :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
! In the stopped state, a server process does not accept new
! connections, and a client process does not handle incoming traffic.
! The stopped state is cleared by `continue-process' and set by
! `stop-process'.
!
! :filter FILTER -- Install FILTER as the process filter.
!
! :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
!
! :log LOG -- Install LOG as the server process log function. This
! function is called as when the server accepts a network connection from a
! client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
! is the server process, CLIENT is the new process for the connection,
! and MESSAGE is a string.
!
! :server BOOL -- if BOOL is non-nil, create a server process for the
! specified FAMILY, SERVICE, and connection type (stream or datagram).
! Default is a client process.
!
! A server process will listen for and accept connections from
! clients. When a client connection is accepted, a new network process
! is created for the connection with the following parameters:
! - The client's process name is constructed by concatenating the server
! process' NAME and a client identification string.
! - If the FILTER argument is non-nil, the client process will not get a
! separate process buffer; otherwise, the client's process buffer is a newly
! created buffer named after the server process' BUFFER name or process
! NAME concatenated with the client identification string.
! - The connection type and the process filter and sentinel parameters are
! inherited from the server process' TYPE, FILTER and SENTINEL.
! - The client process' contact info is set according to the client's
! addressing information (typically an IP address and a port number).
!
! Notice that the FILTER and SENTINEL args are never used directly by
! the server process. Also, the BUFFER argument is not used directly by
! the server process, but via `network-server-log-function' hook, a log
! of the accepted (and failed) connections may be recorded in the server
! process' buffer.
!
! The following special call returns t iff a given KEY VALUE
! pair is supported on this system:
! (make-network-process :feature KEY VALUE) */)
! (nargs, args)
! int nargs;
! Lisp_Object *args;
{
Lisp_Object proc;
+ Lisp_Object contact;
+ struct Lisp_Process *p;
#ifdef HAVE_GETADDRINFO
! struct addrinfo ai, *res, *lres;
! struct addrinfo hints;
! char *portstring, portbuf[128];
#else /* HAVE_GETADDRINFO */
struct _emacs_addrinfo
{
int ai_family;
***************
*** 1834,1983 ****
struct _emacs_addrinfo *ai_next;
} ai, *res, *lres;
#endif /* HAVE_GETADDRINFO */
int ret = 0;
int xerrno = 0;
int s = -1, outch, inch;
! struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
int retry = 0;
int count = specpdl_ptr - specpdl;
int count1;
! int is_non_blocking = 0;
! if (!NILP (non_blocking))
{
! #ifndef NON_BLOCKING_CONNECT
! return Qnil;
! #else
! non_blocking = Qt; /* Instead of GCPRO */
! is_non_blocking = 1;
! #endif
}
#ifdef WINDOWSNT
/* Ensure socket support is loaded if available. */
init_winsock (TRUE);
#endif
! /* Can only GCPRO 5 variables */
! GCPRO6 (name, buffer, host, service, sentinel, filter);
! CHECK_STRING (name);
! CHECK_STRING (host);
! #ifdef HAVE_GETADDRINFO
! /* SERVICE can either be a string or int.
! Convert to a C string for later use by getaddrinfo. */
! if (INTEGERP (service))
{
! sprintf (portbuf, "%ld", (long) XINT (service));
! portstring = portbuf;
}
! else
{
! CHECK_STRING (service);
! portstring = XSTRING (service)->data;
}
! #else /* HAVE_GETADDRINFO */
if (INTEGERP (service))
port = htons ((unsigned short) XINT (service));
else
{
CHECK_STRING (service);
svc_info = getservbyname (XSTRING (service)->data, "tcp");
if (svc_info == 0)
! error ("Unknown service \"%s\"", XSTRING (service)->data);
port = svc_info->s_port;
}
- #endif /* HAVE_GETADDRINFO */
/* Slow down polling to every ten seconds.
Some kernels have a bug which causes retrying connect to fail
after a connect. Polling can interfere with gethostbyname too. */
#ifdef POLL_FOR_INPUT
! record_unwind_protect (unwind_stop_other_atimers, Qnil);
! bind_polling_period (10);
#endif
- #ifndef TERM
#ifdef HAVE_GETADDRINFO
! immediate_quit = 1;
! QUIT;
! memset (&hints, 0, sizeof (hints));
! hints.ai_flags = 0;
! hints.ai_family = AF_UNSPEC;
! hints.ai_socktype = SOCK_STREAM;
! hints.ai_protocol = 0;
! ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
! if (ret)
#ifdef HAVE_GAI_STRERROR
! error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret));
#else
! error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring,
! ret);
#endif
! immediate_quit = 0;
! #else /* not HAVE_GETADDRINFO */
! while (1)
{
! #if 0
! #ifdef TRY_AGAIN
! h_errno = 0;
! #endif
! #endif
immediate_quit = 1;
QUIT;
host_info_ptr = gethostbyname (XSTRING (host)->data);
immediate_quit = 0;
- #if 0
- #ifdef TRY_AGAIN
- if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN))
- #endif
- #endif
- break;
- Fsleep_for (make_number (1), Qnil);
- }
! if (host_info_ptr == 0)
! /* Attempt to interpret host as numeric inet address */
! {
! numeric_addr = inet_addr ((char *) XSTRING (host)->data);
! if (NUMERIC_ADDR_ERROR)
! error ("Unknown host \"%s\"", XSTRING (host)->data);
!
! host_info_ptr = &host_info;
! host_info.h_name = 0;
! host_info.h_aliases = 0;
! host_info.h_addrtype = AF_INET;
! #ifdef h_addr
! /* Older machines have only one address slot called h_addr.
! Newer machines have h_addr_list, but #define h_addr to
! be its first element. */
! host_info.h_addr_list = &(addr_list[0]);
! #endif
! host_info.h_addr = (char*)(&numeric_addr);
! addr_list[1] = 0;
! /* numeric_addr isn't null-terminated; it has fixed length. */
! host_info.h_length = sizeof (numeric_addr);
! }
!
! bzero (&address, sizeof address);
! bcopy (host_info_ptr->h_addr, (char *) &address.sin_addr,
! host_info_ptr->h_length);
! address.sin_family = host_info_ptr->h_addrtype;
! address.sin_port = port;
!
! /* Emulate HAVE_GETADDRINFO for the loop over `res' below. */
! ai.ai_family = host_info_ptr->h_addrtype;
! ai.ai_socktype = SOCK_STREAM;
! ai.ai_protocol = 0;
! ai.ai_addr = (struct sockaddr *) &address;
! ai.ai_addrlen = sizeof address;
! ai.ai_next = NULL;
! res = &ai;
#endif /* not HAVE_GETADDRINFO */
/* Do this in case we never enter the for-loop below. */
count1 = specpdl_ptr - specpdl;
s = -1;
--- 2365,2677 ----
struct _emacs_addrinfo *ai_next;
} ai, *res, *lres;
#endif /* HAVE_GETADDRINFO */
+ struct sockaddr *sa = 0;
+ struct sockaddr_in address_in;
+ #ifdef AF_LOCAL
+ struct sockaddr_un address_un;
+ #endif
+ int port;
int ret = 0;
int xerrno = 0;
int s = -1, outch, inch;
! struct gcpro gcpro1;
int retry = 0;
int count = specpdl_ptr - specpdl;
int count1;
! Lisp_Object QCaddress; /* one of QClocal or QCremote */
! Lisp_Object tem;
! Lisp_Object name, buffer, host, service, address;
! Lisp_Object filter, sentinel;
! int is_non_blocking_client = 0;
! int is_server = 0;
! int socktype = SOCK_STREAM;
! int family = -1;
!
! if (nargs == 0)
! return Qnil;
! /* Handle :feature KEY VALUE query. */
! if (EQ (args[0], QCfeature))
{
! if (nargs != 3)
! return Qnil;
! return network_process_featurep (args[1], args[2]) ? Qt : Qnil;
}
+ /* Save arguments for process-contact and clone-process. */
+ contact = Flist (nargs, args);
+ GCPRO1 (contact);
+
#ifdef WINDOWSNT
/* Ensure socket support is loaded if available. */
init_winsock (TRUE);
#endif
! /* :datagram BOOL */
! tem = Fplist_get (contact, QCdatagram);
! if (!NILP (tem))
! {
! #ifndef DATAGRAM_SOCKETS
! error ("Datagram connections not supported");
! #else
! socktype = SOCK_DGRAM;
! #endif
! }
! /* :server BOOL */
! tem = Fplist_get (contact, QCserver);
! if (!NILP (tem))
{
! #ifdef TERM
! error ("Network servers not supported");
! #else
! is_server = 1;
! #endif
}
!
! /* Make QCaddress an alias for :local (server) or :remote (client). */
! QCaddress = is_server ? QClocal : QCremote;
!
! /* :wait BOOL */
! if (!is_server && socktype == SOCK_STREAM
! && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
{
! #ifndef NON_BLOCKING_CONNECT
! error ("Non-blocking connect not supported");
! #else
! is_non_blocking_client = 1;
! #endif
}
!
! name = Fplist_get (contact, QCname);
! buffer = Fplist_get (contact, QCbuffer);
! filter = Fplist_get (contact, QCfilter);
! sentinel = Fplist_get (contact, QCsentinel);
!
! CHECK_STRING (name);
!
! #ifdef TERM
! /* Let's handle TERM before things get complicated ... */
! host = Fplist_get (contact, QChost);
! CHECK_STRING (host);
!
! service = Fplist_get (contact, QCservice);
if (INTEGERP (service))
port = htons ((unsigned short) XINT (service));
else
{
+ struct servent *svc_info;
CHECK_STRING (service);
svc_info = getservbyname (XSTRING (service)->data, "tcp");
if (svc_info == 0)
! error ("Unknown service: %s", XSTRING (service)->data);
port = svc_info->s_port;
}
+ s = connect_server (0);
+ if (s < 0)
+ report_file_error ("error creating socket", Fcons (name, Qnil));
+ send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port));
+ send_command (s, C_DUMB, 1, 0);
+
+ #else /* not TERM */
+
+ /* Initialize addrinfo structure in case we don't use getaddrinfo. */
+ ai.ai_socktype = socktype;
+ ai.ai_protocol = 0;
+ ai.ai_next = NULL;
+ res = &ai;
+
+ /* :local ADDRESS or :remote ADDRESS */
+ address = Fplist_get (contact, QCaddress);
+ if (!NILP (address))
+ {
+ host = service = Qnil;
+
+ if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
+ error ("Malformed :address");
+ ai.ai_family = family;
+ ai.ai_addr = alloca (ai.ai_addrlen);
+ conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
+ goto open_socket;
+ }
+
+ /* :family FAMILY -- nil (for Inet), local, or integer. */
+ tem = Fplist_get (contact, QCfamily);
+ if (INTEGERP (tem))
+ family = XINT (tem);
+ else
+ {
+ if (NILP (tem))
+ family = AF_INET;
+ #ifdef AF_LOCAL
+ else if (EQ (tem, Qlocal))
+ family = AF_LOCAL;
+ #endif
+ }
+ if (family < 0)
+ error ("Unknown address family");
+ ai.ai_family = family;
+
+ /* :service SERVICE -- string, integer (port number), or t (random port). */
+ service = Fplist_get (contact, QCservice);
+
+ #ifdef AF_LOCAL
+ if (family == AF_LOCAL)
+ {
+ /* Host is not used. */
+ host = Qnil;
+ CHECK_STRING (service);
+ bzero (&address_un, sizeof address_un);
+ address_un.sun_family = AF_LOCAL;
+ strncpy (address_un.sun_path, XSTRING (service)->data, sizeof address_un.sun_path);
+ ai.ai_addr = (struct sockaddr *) &address_un;
+ ai.ai_addrlen = sizeof address_un;
+ goto open_socket;
+ }
+ #endif
+
+ /* :host HOST -- hostname, ip address, or 'local for localhost. */
+ host = Fplist_get (contact, QChost);
+ if (!NILP (host))
+ {
+ if (EQ (host, Qlocal))
+ host = build_string ("localhost");
+ CHECK_STRING (host);
+ }
/* Slow down polling to every ten seconds.
Some kernels have a bug which causes retrying connect to fail
after a connect. Polling can interfere with gethostbyname too. */
#ifdef POLL_FOR_INPUT
! if (socktype == SOCK_STREAM)
! {
! record_unwind_protect (unwind_stop_other_atimers, Qnil);
! bind_polling_period (10);
! }
#endif
#ifdef HAVE_GETADDRINFO
! /* If we have a host, use getaddrinfo to resolve both host and service.
! Otherwise, use getservbyname to lookup the service. */
! if (!NILP (host))
! {
!
! /* SERVICE can either be a string or int.
! Convert to a C string for later use by getaddrinfo. */
! if (EQ (service, Qt))
! portstring = "0";
! else if (INTEGERP (service))
! {
! sprintf (portbuf, "%ld", (long) XINT (service));
! portstring = portbuf;
! }
! else
! {
! CHECK_STRING (service);
! portstring = XSTRING (service)->data;
! }
!
! immediate_quit = 1;
! QUIT;
! memset (&hints, 0, sizeof (hints));
! hints.ai_flags = 0;
! hints.ai_family = NILP (Fplist_member (QCfamily)) ? AF_UNSPEC : family;
! hints.ai_socktype = socktype;
! hints.ai_protocol = 0;
! ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
! if (ret)
#ifdef HAVE_GAI_STRERROR
! error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret));
#else
! error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring, ret);
#endif
! immediate_quit = 0;
!
! goto open_socket;
! }
! #endif /* HAVE_GETADDRINFO */
! /* We end up here if getaddrinfo is not defined, or in case no hostname
! has been specified (e.g. for a local server process). */
! if (EQ (service, Qt))
! port = 0;
! else if (INTEGERP (service))
! port = htons ((unsigned short) XINT (service));
! else
{
! struct servent *svc_info;
! CHECK_STRING (service);
! svc_info = getservbyname (XSTRING (service)->data,
! (socktype == SOCK_DGRAM ? "udp" : "tcp"));
! if (svc_info == 0)
! error ("Unknown service: %s", XSTRING (service)->data);
! port = svc_info->s_port;
! }
!
! bzero (&address_in, sizeof address_in);
! address_in.sin_family = family;
! address_in.sin_addr.s_addr = INADDR_ANY;
! address_in.sin_port = port;
!
! #ifndef HAVE_GETADDRINFO
! if (!NILP (host))
! {
! struct hostent *host_info_ptr;
!
! /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
! as it may `hang' emacs for a very long time. */
immediate_quit = 1;
QUIT;
host_info_ptr = gethostbyname (XSTRING (host)->data);
immediate_quit = 0;
! if (host_info_ptr)
! {
! bcopy (host_info_ptr->h_addr, (char *) &address_in.sin_addr,
! host_info_ptr->h_length);
! family = host_info_ptr->h_addrtype;
! address_in.sin_family = family;
! }
! else
! /* Attempt to interpret host as numeric inet address */
! {
! IN_ADDR numeric_addr;
! numeric_addr = inet_addr ((char *) XSTRING (host)->data);
! if (NUMERIC_ADDR_ERROR)
! error ("Unknown host \"%s\"", XSTRING (host)->data);
!
! bcopy ((char *)&numeric_addr, (char *) &address_in.sin_addr,
! sizeof (address_in.sin_addr));
! }
!
! }
#endif /* not HAVE_GETADDRINFO */
+ ai.ai_family = family;
+ ai.ai_addr = (struct sockaddr *) &address_in;
+ ai.ai_addrlen = sizeof address_in;
+
+ open_socket:
+
+ /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
+ when connect is interrupted. So let's not let it get interrupted.
+ Note we do not turn off polling, because polling is only used
+ when not interrupt_input, and thus not normally used on the systems
+ which have this bug. On systems which use polling, there's no way
+ to quit if polling is turned off. */
+ if (interrupt_input
+ && !is_server && socktype == SOCK_STREAM)
+ {
+ /* Comment from KFS: The original open-network-stream code
+ didn't unwind protect this, but it seems like the proper
+ thing to do. In any case, I don't see how it could harm to
+ do this -- and it makes cleanup (using unbind_to) easier. */
+ record_unwind_protect (unwind_request_sigio, Qnil);
+ unrequest_sigio ();
+ }
+
/* Do this in case we never enter the for-loop below. */
count1 = specpdl_ptr - specpdl;
s = -1;
***************
*** 1991,1998 ****
continue;
}
#ifdef NON_BLOCKING_CONNECT
! if (is_non_blocking)
{
#ifdef O_NONBLOCK
ret = fcntl (s, F_SETFL, O_NONBLOCK);
--- 2685,2697 ----
continue;
}
+ #ifdef DATAGRAM_SOCKETS
+ if (!is_server && socktype == SOCK_DGRAM)
+ break;
+ #endif /* DATAGRAM_SOCKETS */
+
#ifdef NON_BLOCKING_CONNECT
! if (is_non_blocking_client)
{
#ifdef O_NONBLOCK
ret = fcntl (s, F_SETFL, O_NONBLOCK);
***************
*** 2008,2028 ****
}
}
#endif
!
! /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
! when connect is interrupted. So let's not let it get interrupted.
! Note we do not turn off polling, because polling is only used
! when not interrupt_input, and thus not normally used on the systems
! which have this bug. On systems which use polling, there's no way
! to quit if polling is turned off. */
! if (interrupt_input)
! unrequest_sigio ();
!
/* Make us close S if quit. */
- count1 = specpdl_ptr - specpdl;
record_unwind_protect (close_file_unwind, make_number (s));
! loop:
immediate_quit = 1;
QUIT;
--- 2707,2752 ----
}
}
#endif
!
/* Make us close S if quit. */
record_unwind_protect (close_file_unwind, make_number (s));
! if (is_server)
! {
! /* Configure as a server socket. */
! #ifdef AF_LOCAL
! if (family != AF_LOCAL)
! #endif
! {
! int optval = 1;
! if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
! report_file_error ("Cannot set reuse option on server socket.", Qnil);
! }
!
! if (bind (s, lres->ai_addr, lres->ai_addrlen))
! report_file_error ("Cannot bind server socket", Qnil);
!
! #ifdef HAVE_GETSOCKNAME
! if (EQ (service, Qt))
! {
! struct sockaddr_in sa1;
! int len1 = sizeof (sa1);
! if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
! {
! ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
! service = make_number (sa1.sin_port);
! contact = Fplist_put (contact, QCservice, service);
! }
! }
! #endif
!
! if (socktype == SOCK_STREAM && listen (s, 5))
! report_file_error ("Cannot listen on server socket", Qnil);
!
! break;
! }
!
! retry_connect:
immediate_quit = 1;
QUIT;
***************
*** 2046,2052 ****
if (ret == 0 || xerrno == EISCONN)
{
- is_non_blocking = 0;
/* The unwind-protect will be discarded afterwards.
Likewise for immediate_quit. */
break;
--- 2770,2775 ----
***************
*** 2054,2064 ****
#ifdef NON_BLOCKING_CONNECT
#ifdef EINPROGRESS
! if (is_non_blocking && xerrno == EINPROGRESS)
break;
#else
#ifdef EWOULDBLOCK
! if (is_non_blocking && xerrno == EWOULDBLOCK)
break;
#endif
#endif
--- 2777,2787 ----
#ifdef NON_BLOCKING_CONNECT
#ifdef EINPROGRESS
! if (is_non_blocking_client && xerrno == EINPROGRESS)
break;
#else
#ifdef EWOULDBLOCK
! if (is_non_blocking_client && xerrno == EWOULDBLOCK)
break;
#endif
#endif
***************
*** 2067,2073 ****
immediate_quit = 0;
if (xerrno == EINTR)
! goto loop;
if (xerrno == EADDRINUSE && retry < 20)
{
/* A delay here is needed on some FreeBSD systems,
--- 2790,2796 ----
immediate_quit = 0;
if (xerrno == EINTR)
! goto retry_connect;
if (xerrno == EADDRINUSE && retry < 20)
{
/* A delay here is needed on some FreeBSD systems,
***************
*** 2075,2136 ****
and should be infrequent. */
Fsleep_for (make_number (1), Qnil);
retry++;
! goto loop;
}
/* Discard the unwind protect closing S. */
specpdl_ptr = specpdl + count1;
- count1 = specpdl_ptr - specpdl;
-
emacs_close (s);
s = -1;
}
#ifdef HAVE_GETADDRINFO
! freeaddrinfo (res);
#endif
if (s < 0)
{
- if (interrupt_input)
- request_sigio ();
-
/* If non-blocking got this far - and failed - assume non-blocking is
not supported after all. This is probably a wrong assumption, but
! the normal blocking calls to open-network-stream handles this error
! better. */
! if (is_non_blocking)
! {
! #ifdef POLL_FOR_INPUT
! unbind_to (count, Qnil);
! #endif
return Qnil;
- }
errno = xerrno;
! report_file_error ("connection failed",
! Fcons (host, Fcons (name, Qnil)));
}
-
- immediate_quit = 0;
-
- /* Discard the unwind protect, if any. */
- specpdl_ptr = specpdl + count1;
-
- #ifdef POLL_FOR_INPUT
- unbind_to (count, Qnil);
- #endif
! if (interrupt_input)
! request_sigio ();
!
! #else /* TERM */
! s = connect_server (0);
! if (s < 0)
! report_file_error ("error creating socket", Fcons (name, Qnil));
! send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port));
! send_command (s, C_DUMB, 1, 0);
! #endif /* TERM */
inch = s;
outch = s;
--- 2798,2861 ----
and should be infrequent. */
Fsleep_for (make_number (1), Qnil);
retry++;
! goto retry_connect;
}
/* Discard the unwind protect closing S. */
specpdl_ptr = specpdl + count1;
emacs_close (s);
s = -1;
}
+ if (s >= 0)
+ {
+ #ifdef DATAGRAM_SOCKETS
+ if (socktype == SOCK_DGRAM)
+ {
+ if (datagram_address[s].sa)
+ abort ();
+ datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen);
+ datagram_address[s].len = lres->ai_addrlen;
+ if (is_server)
+ bzero (datagram_address[s].sa, lres->ai_addrlen);
+ else
+ bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen);
+ }
+ #endif
+ contact = Fplist_put (contact, QCaddress,
+ conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
+ }
+
#ifdef HAVE_GETADDRINFO
! if (res != &ai)
! freeaddrinfo (res);
#endif
+ immediate_quit = 0;
+
+ /* Discard the unwind protect for closing S, if any. */
+ specpdl_ptr = specpdl + count1;
+
+ /* Unwind bind_polling_period and request_sigio. */
+ unbind_to (count, Qnil);
+
if (s < 0)
{
/* If non-blocking got this far - and failed - assume non-blocking is
not supported after all. This is probably a wrong assumption, but
! the normal blocking calls to open-network-stream handles this error
! better. */
! if (is_non_blocking_client)
return Qnil;
errno = xerrno;
! if (is_server)
! report_file_error ("make server process failed", contact);
! else
! report_file_error ("make client process failed", contact);
}
! #endif /* not TERM */
inch = s;
outch = s;
***************
*** 2149,2172 ****
#endif
#endif
! XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
! XPROCESS (proc)->command_channel_p = Qnil;
! XPROCESS (proc)->buffer = buffer;
! XPROCESS (proc)->sentinel = sentinel;
! XPROCESS (proc)->filter = filter;
! XPROCESS (proc)->command = Qnil;
! XPROCESS (proc)->pid = Qnil;
! XSETINT (XPROCESS (proc)->infd, inch);
! XSETINT (XPROCESS (proc)->outfd, outch);
! XPROCESS (proc)->status = Qrun;
#ifdef NON_BLOCKING_CONNECT
! if (!NILP (non_blocking))
{
/* We may get here if connect did succeed immediately. However,
in that case, we still need to signal this like a non-blocking
connection. */
! XPROCESS (proc)->status = Qconnect;
if (!FD_ISSET (inch, &connect_wait_mask))
{
FD_SET (inch, &connect_wait_mask);
--- 2874,2903 ----
#endif
#endif
! p = XPROCESS (proc);
!
! p->childp = contact;
! p->buffer = buffer;
! p->sentinel = sentinel;
! p->filter = filter;
! p->log = Fplist_get (contact, QClog);
! if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
! p->kill_without_query = Qt;
! if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
! p->command = Qt;
! p->pid = Qnil;
! XSETINT (p->infd, inch);
! XSETINT (p->outfd, outch);
! if (is_server && socktype == SOCK_STREAM)
! p->status = Qlisten;
#ifdef NON_BLOCKING_CONNECT
! if (is_non_blocking_client)
{
/* We may get here if connect did succeed immediately. However,
in that case, we still need to signal this like a non-blocking
connection. */
! p->status = Qconnect;
if (!FD_ISSET (inch, &connect_wait_mask))
{
FD_SET (inch, &connect_wait_mask);
***************
*** 2175,2181 ****
}
else
#endif
! if (!EQ (XPROCESS (proc)->filter, Qt))
{
FD_SET (inch, &input_wait_mask);
FD_SET (inch, &non_keyboard_wait_mask);
--- 2906,2915 ----
}
else
#endif
! /* A server may have a client filter setting of Qt, but it must
! still listen for incoming connects unless it is stopped. */
! if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
! || (EQ (p->status, Qlisten) && NILP (p->command)))
{
FD_SET (inch, &input_wait_mask);
FD_SET (inch, &non_keyboard_wait_mask);
***************
*** 2214,2220 ****
else
val = Qnil;
}
! XPROCESS (proc)->decode_coding_system = val;
if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
--- 2948,2954 ----
else
val = Qnil;
}
! p->decode_coding_system = val;
if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
***************
*** 2237,2262 ****
else
val = Qnil;
}
! XPROCESS (proc)->encode_coding_system = val;
}
if (!proc_decode_coding_system[inch])
proc_decode_coding_system[inch]
= (struct coding_system *) xmalloc (sizeof (struct coding_system));
! setup_coding_system (XPROCESS (proc)->decode_coding_system,
proc_decode_coding_system[inch]);
if (!proc_encode_coding_system[outch])
proc_encode_coding_system[outch]
= (struct coding_system *) xmalloc (sizeof (struct coding_system));
! setup_coding_system (XPROCESS (proc)->encode_coding_system,
proc_encode_coding_system[outch]);
! XPROCESS (proc)->decoding_buf = make_uninit_string (0);
! XPROCESS (proc)->decoding_carryover = make_number (0);
! XPROCESS (proc)->encoding_buf = make_uninit_string (0);
! XPROCESS (proc)->encoding_carryover = make_number (0);
! XPROCESS (proc)->inherit_coding_system_flag
= (NILP (buffer) || !inherit_process_coding_system
? Qnil : Qt);
--- 2971,2996 ----
else
val = Qnil;
}
! p->encode_coding_system = val;
}
if (!proc_decode_coding_system[inch])
proc_decode_coding_system[inch]
= (struct coding_system *) xmalloc (sizeof (struct coding_system));
! setup_coding_system (p->decode_coding_system,
proc_decode_coding_system[inch]);
if (!proc_encode_coding_system[outch])
proc_encode_coding_system[outch]
= (struct coding_system *) xmalloc (sizeof (struct coding_system));
! setup_coding_system (p->encode_coding_system,
proc_encode_coding_system[outch]);
! p->decoding_buf = make_uninit_string (0);
! p->decoding_carryover = make_number (0);
! p->encoding_buf = make_uninit_string (0);
! p->encoding_carryover = make_number (0);
! p->inherit_coding_system_flag
= (NILP (buffer) || !inherit_process_coding_system
? Qnil : Qt);
***************
*** 2295,2300 ****
--- 3029,3042 ----
XSETINT (p->infd, -1);
XSETINT (p->outfd, -1);
+ #ifdef DATAGRAM_SOCKETS
+ if (DATAGRAM_CHAN_P (inchannel))
+ {
+ xfree (datagram_address[inchannel].sa);
+ datagram_address[inchannel].sa = 0;
+ datagram_address[inchannel].len = 0;
+ }
+ #endif
chan_process[inchannel] = Qnil;
FD_CLR (inchannel, &input_wait_mask);
FD_CLR (inchannel, &non_keyboard_wait_mask);
***************
*** 2411,2416 ****
--- 3153,3353 ----
? Qt : Qnil);
}
+ /* Accept a connection for server process SERVER on CHANNEL. */
+
+ static int connect_counter = 0;
+
+ static void
+ server_accept_connection (server, channel)
+ Lisp_Object server;
+ int channel;
+ {
+ Lisp_Object proc, caller, name, buffer;
+ Lisp_Object contact, host, service;
+ struct Lisp_Process *ps= XPROCESS (server);
+ struct Lisp_Process *p;
+ int s;
+ union u_sockaddr {
+ struct sockaddr sa;
+ struct sockaddr_in in;
+ #ifdef AF_LOCAL
+ struct sockaddr_un un;
+ #endif
+ } saddr;
+ int len = sizeof saddr;
+
+ s = accept (channel, &saddr.sa, &len);
+
+ if (s < 0)
+ {
+ int code = errno;
+
+ if (code == EAGAIN)
+ return;
+ #ifdef EWOULDBLOCK
+ if (code == EWOULDBLOCK)
+ return;
+ #endif
+
+ if (!NILP (ps->log))
+ call3 (ps->log, server, Qnil,
+ concat3 (build_string ("accept failed with code"),
+ Fnumber_to_string (make_number (code)),
+ build_string ("\n")));
+ return;
+ }
+
+ connect_counter++;
+
+ /* Setup a new process to handle the connection. */
+
+ /* Generate a unique identification of the caller, and build contact
+ information for this process. */
+ host = Qt;
+ service = Qnil;
+ switch (saddr.sa.sa_family)
+ {
+ case AF_INET:
+ {
+ Lisp_Object args[5];
+ unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
+ args[0] = build_string ("%d.%d.%d.%d");
+ args[1] = make_number (*ip++);
+ args[2] = make_number (*ip++);
+ args[3] = make_number (*ip++);
+ args[4] = make_number (*ip++);
+ host = Fformat (5, args);
+ service = make_number (ntohs (saddr.in.sin_port));
+
+ args[0] = build_string (" <%s:%d>");
+ args[1] = host;
+ args[2] = service;
+ caller = Fformat (3, args);
+ }
+ break;
+
+ #ifdef AF_LOCAL
+ case AF_LOCAL:
+ #endif
+ default:
+ caller = Fnumber_to_string (make_number (connect_counter));
+ caller = concat3 (build_string (" <*"), caller, build_string ("*>"));
+ break;
+ }
+
+ /* Create a new buffer name for this process if it doesn't have a
+ filter. The new buffer name is based on the buffer name or
+ process name of the server process concatenated with the caller
+ identification. */
+
+ if (!NILP (ps->filter) && !EQ (ps->filter, Qt))
+ buffer = Qnil;
+ else
+ {
+ buffer = ps->buffer;
+ if (!NILP (buffer))
+ buffer = Fbuffer_name (buffer);
+ else
+ buffer = ps->name;
+ if (!NILP (buffer))
+ {
+ buffer = concat2 (buffer, caller);
+ buffer = Fget_buffer_create (buffer);
+ }
+ }
+
+ /* Generate a unique name for the new server process. Combine the
+ server process name with the caller identification. */
+
+ name = concat2 (ps->name, caller);
+ proc = make_process (name);
+
+ chan_process[s] = proc;
+
+ #ifdef O_NONBLOCK
+ fcntl (s, F_SETFL, O_NONBLOCK);
+ #else
+ #ifdef O_NDELAY
+ fcntl (s, F_SETFL, O_NDELAY);
+ #endif
+ #endif
+
+ p = XPROCESS (proc);
+
+ /* Build new contact information for this setup. */
+ contact = Fcopy_sequence (ps->childp);
+ contact = Fplist_put (contact, QChost, host);
+ if (!NILP (service))
+ contact = Fplist_put (contact, QCservice, service);
+ contact = Fplist_put (contact, QCremote,
+ conv_sockaddr_to_lisp (&saddr.sa, len));
+ #ifdef HAVE_GETSOCKNAME
+ len = sizeof saddr;
+ if (getsockname (channel, &saddr.sa, &len) == 0)
+ contact = Fplist_put (contact, QClocal,
+ conv_sockaddr_to_lisp (&saddr.sa, len));
+ #endif
+
+ p->childp = contact;
+ p->buffer = buffer;
+ p->sentinel = ps->sentinel;
+ p->filter = ps->filter;
+ p->command = Qnil;
+ p->pid = Qnil;
+ XSETINT (p->infd, s);
+ XSETINT (p->outfd, s);
+ p->status = Qrun;
+
+ /* Client processes for accepted connections are not stopped initially. */
+ if (!EQ (p->filter, Qt))
+ {
+ FD_SET (s, &input_wait_mask);
+ FD_SET (s, &non_keyboard_wait_mask);
+ }
+
+ if (s > max_process_desc)
+ max_process_desc = s;
+
+ /* Setup coding system for new process based on server process.
+ This seems to be the proper thing to do, as the coding system
+ of the new process should reflect the settings at the time the
+ server socket was opened; not the current settings. */
+
+ p->decode_coding_system = ps->decode_coding_system;
+ p->encode_coding_system = ps->encode_coding_system;
+
+ if (!proc_decode_coding_system[s])
+ proc_decode_coding_system[s]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ setup_coding_system (p->decode_coding_system,
+ proc_decode_coding_system[s]);
+ if (!proc_encode_coding_system[s])
+ proc_encode_coding_system[s]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ setup_coding_system (p->encode_coding_system,
+ proc_encode_coding_system[s]);
+
+ p->decoding_buf = make_uninit_string (0);
+ p->decoding_carryover = make_number (0);
+ p->encoding_buf = make_uninit_string (0);
+ p->encoding_carryover = make_number (0);
+
+ p->inherit_coding_system_flag
+ = (NILP (buffer) ? Qnil : ps->inherit_coding_system_flag);
+
+ if (!NILP (ps->log))
+ call3 (ps->log, server, proc,
+ concat3 (build_string ("accept from "),
+ (STRINGP (host) ? host : build_string ("-")),
+ build_string ("\n")));
+
+ if (p->sentinel)
+ exec_sentinel (proc,
+ concat3 (build_string ("open from "),
+ (STRINGP (host) ? host : build_string ("-")),
+ build_string ("\n")));
+ }
+
/* This variable is different from waiting_for_input in keyboard.c.
It is used to communicate to a lisp process-filter/sentinel (via the
function Fwaiting_for_user_input_p below) whether emacs was waiting
***************
*** 2909,2914 ****
--- 3846,3858 ----
if (NILP (proc))
continue;
+ /* If this is a server stream socket, accept connection. */
+ if (EQ (XPROCESS (proc)->status, Qlisten))
+ {
+ server_accept_connection (proc, channel);
+ continue;
+ }
+
/* Read data from the process, starting with our
buffered-ahead character if we have one. */
***************
*** 2983,2989 ****
{
struct Lisp_Process *p;
struct sockaddr pname;
! socklen_t pnamelen = sizeof(pname);
FD_CLR (channel, &connect_wait_mask);
if (--num_pending_connects < 0)
--- 3927,3933 ----
{
struct Lisp_Process *p;
struct sockaddr pname;
! int pnamelen = sizeof(pname);
FD_CLR (channel, &connect_wait_mask);
if (--num_pending_connects < 0)
***************
*** 2999,3005 ****
/* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
So only use it on systems where it is known to work. */
{
! socklen_t xlen = sizeof(xerrno);
if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
xerrno = errno;
}
--- 3943,3949 ----
/* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
So only use it on systems where it is known to work. */
{
! int xlen = sizeof(xerrno);
if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
xerrno = errno;
}
***************
*** 3028,3034 ****
status_notify to do it later, it will read input
from the process before calling the sentinel. */
exec_sentinel (proc, build_string ("open\n"));
! if (!EQ (p->filter, Qt))
{
FD_SET (XINT (p->infd), &input_wait_mask);
FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
--- 3972,3978 ----
status_notify to do it later, it will read input
from the process before calling the sentinel. */
exec_sentinel (proc, build_string ("open\n"));
! if (!EQ (p->filter, Qt) && !EQ (p->command, Qt))
{
FD_SET (XINT (p->infd), &input_wait_mask);
FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
***************
*** 3106,3111 ****
--- 4050,4056 ----
register int opoint;
struct coding_system *coding = proc_decode_coding_system[channel];
int carryover = XINT (p->decoding_carryover);
+ int readmax = 1024;
#ifdef VMS
VMS_PROC_STUFF *vs, *get_vms_process_pointer();
***************
*** 3137,3154 ****
bcopy (vs->inputBuffer, chars + carryover, nbytes);
}
#else /* not VMS */
! chars = (char *) alloca (carryover + 1024);
if (carryover)
/* See the comment above. */
bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
if (proc_buffered_char[channel] < 0)
! nbytes = emacs_read (channel, chars + carryover, 1024 - carryover);
else
{
chars[carryover] = proc_buffered_char[channel];
proc_buffered_char[channel] = -1;
! nbytes = emacs_read (channel, chars + carryover + 1, 1023 - carryover);
if (nbytes < 0)
nbytes = 1;
else
--- 4082,4120 ----
bcopy (vs->inputBuffer, chars + carryover, nbytes);
}
#else /* not VMS */
!
! #ifdef DATAGRAM_SOCKETS
! /* A datagram is one packet; allow at least 1500+ bytes of data
! corresponding to the typical Ethernet frame size. */
! if (DATAGRAM_CHAN_P (channel))
! {
! /* carryover = 0; */ /* Does carryover make sense for datagrams? */
! readmax += 1024;
! }
! #endif
!
! chars = (char *) alloca (carryover + readmax);
if (carryover)
/* See the comment above. */
bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
+ #ifdef DATAGRAM_SOCKETS
+ /* We have a working select, so proc_buffered_char is always -1. */
+ if (DATAGRAM_CHAN_P (channel))
+ {
+ int len = datagram_address[channel].len;
+ nbytes = recvfrom (channel, chars + carryover, readmax - carryover,
+ 0, datagram_address[channel].sa, &len);
+ }
+ else
+ #endif
if (proc_buffered_char[channel] < 0)
! nbytes = emacs_read (channel, chars + carryover, readmax - carryover);
else
{
chars[carryover] = proc_buffered_char[channel];
proc_buffered_char[channel] = -1;
! nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1 - carryover);
if (nbytes < 0)
nbytes = 1;
else
***************
*** 3614,3622 ****
/* Send this batch, using one or more write calls. */
while (this > 0)
{
old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
! rv = emacs_write (XINT (XPROCESS (proc)->outfd),
! (char *) buf, this);
signal (SIGPIPE, old_sigpipe);
if (rv < 0)
--- 4580,4599 ----
/* Send this batch, using one or more write calls. */
while (this > 0)
{
+ int outfd = XINT (XPROCESS (proc)->outfd);
old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
! #ifdef DATAGRAM_SOCKETS
! if (DATAGRAM_CHAN_P (outfd))
! {
! rv = sendto (outfd, (char *) buf, this,
! 0, datagram_address[outfd].sa,
! datagram_address[outfd].len);
! if (rv < 0 && errno == EMSGSIZE)
! report_file_error ("sending datagram", Fcons (proc, Qnil));
! }
! else
! #endif
! rv = emacs_write (outfd, (char *) buf, this);
signal (SIGPIPE, old_sigpipe);
if (rv < 0)
***************
*** 4071,4080 ****
DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
doc: /* Stop process PROCESS. May be process or name of one.
! See function `interrupt-process' for more details on usage. */)
(process, current_group)
Lisp_Object process, current_group;
{
#ifndef SIGTSTP
error ("no SIGTSTP support");
#else
--- 5048,5074 ----
DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
doc: /* Stop process PROCESS. May be process or name of one.
! See function `interrupt-process' for more details on usage.
! If PROCESS is a network process, inhibit handling of incoming traffic. */)
(process, current_group)
Lisp_Object process, current_group;
{
+ #ifdef HAVE_SOCKETS
+ if (PROCESSP (process) && NETCONN_P (process))
+ {
+ struct Lisp_Process *p;
+
+ p = XPROCESS (process);
+ if (NILP (p->command)
+ && XINT (p->infd) >= 0)
+ {
+ FD_CLR (XINT (p->infd), &input_wait_mask);
+ FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
+ }
+ p->command = Qt;
+ return process;
+ }
+ #endif
#ifndef SIGTSTP
error ("no SIGTSTP support");
#else
***************
*** 4085,4094 ****
DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
doc: /* Continue process PROCESS. May be process or name of one.
! See function `interrupt-process' for more details on usage. */)
(process, current_group)
Lisp_Object process, current_group;
{
#ifdef SIGCONT
process_send_signal (process, SIGCONT, current_group, 0);
#else
--- 5079,5106 ----
DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
doc: /* Continue process PROCESS. May be process or name of one.
! See function `interrupt-process' for more details on usage.
! If PROCESS is a network process, resume handling of incoming traffic. */)
(process, current_group)
Lisp_Object process, current_group;
{
+ #ifdef HAVE_SOCKETS
+ if (PROCESSP (process) && NETCONN_P (process))
+ {
+ struct Lisp_Process *p;
+
+ p = XPROCESS (process);
+ if (EQ (p->command, Qt)
+ && XINT (p->infd) >= 0
+ && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
+ {
+ FD_SET (XINT (p->infd), &input_wait_mask);
+ FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
+ }
+ p->command = Qnil;
+ return process;
+ }
+ #endif
#ifdef SIGCONT
process_send_signal (process, SIGCONT, current_group, 0);
#else
***************
*** 4235,4240 ****
--- 5247,5255 ----
Lisp_Object proc;
struct coding_system *coding;
+ if (DATAGRAM_CONN_P (process))
+ return process;
+
proc = get_process (process);
coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
***************
*** 4619,4624 ****
--- 5634,5641 ----
/* If process is still active, read any output that remains. */
while (! EQ (p->filter, Qt)
&& ! EQ (p->status, Qconnect)
+ && ! EQ (p->status, Qlisten)
+ && ! EQ (p->command, Qt) /* Network process not stopped. */
&& XINT (p->infd) >= 0
&& read_process_output (proc, XINT (p->infd)) > 0);
***************
*** 4829,4834 ****
--- 5846,5854 ----
}
bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
+ #ifdef DATAGRAM_SOCKETS
+ bzero (datagram_address, sizeof datagram_address);
+ #endif
}
void
***************
*** 4857,4863 ****
staticpro (&Qconnect);
Qfailed = intern ("failed");
staticpro (&Qfailed);
!
Qlast_nonmenu_event = intern ("last-nonmenu-event");
staticpro (&Qlast_nonmenu_event);
--- 5877,5920 ----
staticpro (&Qconnect);
Qfailed = intern ("failed");
staticpro (&Qfailed);
! Qlisten = intern ("listen");
! staticpro (&Qlisten);
! Qlocal = intern ("local");
! staticpro (&Qlocal);
!
! QCname = intern (":name");
! staticpro (&QCname);
! QCbuffer = intern (":buffer");
! staticpro (&QCbuffer);
! QChost = intern (":host");
! staticpro (&QChost);
! QCservice = intern (":service");
! staticpro (&QCservice);
! QCfamily = intern (":family");
! staticpro (&QCfamily);
! QClocal = intern (":local");
! staticpro (&QClocal);
! QCremote = intern (":remote");
! staticpro (&QCremote);
! QCserver = intern (":server");
! staticpro (&QCserver);
! QCdatagram = intern (":datagram");
! staticpro (&QCdatagram);
! QCnowait = intern (":nowait");
! staticpro (&QCnowait);
! QCfilter = intern (":filter");
! staticpro (&QCfilter);
! QCsentinel = intern (":sentinel");
! staticpro (&QCsentinel);
! QClog = intern (":log");
! staticpro (&QClog);
! QCnoquery = intern (":noquery");
! staticpro (&QCnoquery);
! QCstop = intern (":stop");
! staticpro (&QCstop);
! QCfeature = intern (":feature");
! staticpro (&QCfeature);
!
Qlast_nonmenu_event = intern ("last-nonmenu-event");
staticpro (&Qlast_nonmenu_event);
***************
*** 4897,4910 ****
defsubr (&Sset_process_window_size);
defsubr (&Sset_process_inherit_coding_system_flag);
defsubr (&Sprocess_inherit_coding_system_flag);
! defsubr (&Sprocess_kill_without_query);
defsubr (&Sprocess_contact);
defsubr (&Slist_processes);
defsubr (&Sprocess_list);
defsubr (&Sstart_process);
#ifdef HAVE_SOCKETS
! defsubr (&Sopen_network_stream);
#endif /* HAVE_SOCKETS */
defsubr (&Saccept_process_output);
defsubr (&Sprocess_send_region);
defsubr (&Sprocess_send_string);
--- 5954,5972 ----
defsubr (&Sset_process_window_size);
defsubr (&Sset_process_inherit_coding_system_flag);
defsubr (&Sprocess_inherit_coding_system_flag);
! defsubr (&Sset_process_query_on_exit_flag);
! defsubr (&Sprocess_query_on_exit_flag);
defsubr (&Sprocess_contact);
defsubr (&Slist_processes);
defsubr (&Sprocess_list);
defsubr (&Sstart_process);
#ifdef HAVE_SOCKETS
! defsubr (&Smake_network_process);
#endif /* HAVE_SOCKETS */
+ #ifdef DATAGRAM_SOCKETS
+ defsubr (&Sprocess_datagram_address);
+ defsubr (&Sset_process_datagram_address);
+ #endif
defsubr (&Saccept_process_output);
defsubr (&Sprocess_send_region);
defsubr (&Sprocess_send_string);
Index: lisp/ChangeLog
===================================================================
RCS file: /cvs/emacs/lisp/ChangeLog,v
retrieving revision 1.3574
diff -c -r1.3574 ChangeLog
*** lisp/ChangeLog 13 Mar 2002 17:41:53 -0000 1.3574
--- lisp/ChangeLog 13 Mar 2002 23:14:01 -0000
***************
*** 1,3 ****
--- 1,24 ----
+ 2002-03-13 Kim F. Storm <storm@cua.dk>
+
+ The following changes are related to the enhanced network process
+ support.
+
+ * simple.el (clone-process): Use make-network-process to clone
+ network processes. Get command list via (process-contact ... t).
+ Use set-process-query-on-exit-flag and process-query-on-exit-flag
+ instead of process-kill-without-query.
+ (open-network-stream): Replaces C-version from process.c.
+ (open-network-stream-nowait, open-network-stream-server): New
+ functions.
+ (process-kill-without-query): Replaces C-version from process.c.
+
+ * files.el (save-buffers-kill-emacs): Also check for active server
+ processes. Use process-query-on-exit-flag. Only list processes
+ which has the query-on-exit flag set in connection with user query.
+
+ * shadowfile.el (shadow-save-buffers-kill-emacs): Also check for
+ active server processes. Use process-query-on-exit-flag.
+
2002-03-13 Francesco Potorti` <pot@gnu.org>
* progmodes/etags.el (tag-exact-file-name-match-p)
Index: lisp/simple.el
===================================================================
RCS file: /cvs/emacs/lisp/simple.el,v
retrieving revision 1.524
diff -c -r1.524 simple.el
*** lisp/simple.el 9 Mar 2002 09:05:08 -0000 1.524
--- lisp/simple.el 13 Mar 2002 23:14:03 -0000
***************
*** 3932,3948 ****
(setq newname (substring newname 0 (match-beginning 0))))
(when (memq (process-status process) '(run stop open))
(let* ((process-connection-type (process-tty-name process))
- (old-kwoq (process-kill-without-query process nil))
(new-process
(if (memq (process-status process) '(open))
! (apply 'open-network-stream newname
! (if (process-buffer process) (current-buffer))
! (process-contact process))
(apply 'start-process newname
(if (process-buffer process) (current-buffer))
(process-command process)))))
! (process-kill-without-query new-process old-kwoq)
! (process-kill-without-query process old-kwoq)
(set-process-inherit-coding-system-flag
new-process (process-inherit-coding-system-flag process))
(set-process-filter new-process (process-filter process))
--- 3932,3949 ----
(setq newname (substring newname 0 (match-beginning 0))))
(when (memq (process-status process) '(run stop open))
(let* ((process-connection-type (process-tty-name process))
(new-process
(if (memq (process-status process) '(open))
! (let ((args (process-contact process t)))
! (setq args (plist-put args :name newname))
! (setq args (plist-put args :buffer
! (if (process-buffer process) (current-buffer))))
! (apply 'make-network-process args))
(apply 'start-process newname
(if (process-buffer process) (current-buffer))
(process-command process)))))
! (set-process-query-on-exit-flag
! new-process (process-query-on-exit-flag process))
(set-process-inherit-coding-system-flag
new-process (process-inherit-coding-system-flag process))
(set-process-filter new-process (process-filter process))
***************
*** 4202,4207 ****
--- 4203,4290 ----
(message "Delete key deletes %s"
(if normal-erase-is-backspace "forward" "backward"))))
+
+ ;;; make-network-process wrappers
+
+ (if (fboundp 'make-network-process)
+ (progn
+
+ (defun open-network-stream (name buffer host service)
+ "Open a TCP connection for a service to a host.
+ Returns a subprocess-object to represent the connection.
+ Input and output work as for subprocesses; `delete-process' closes it.
+ Args are NAME BUFFER HOST SERVICE.
+ NAME is name for process. It is modified if necessary to make it unique.
+ BUFFER is the buffer (or buffer-name) to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer
+ Third arg is name of the host to connect to, or its IP address.
+ Fourth arg SERVICE is name of the service desired, or an integer
+ specifying a port number to connect to."
+ (make-network-process :name name :buffer buffer
+ :host host :service service))
+
+ (defun open-network-stream-nowait (name buffer host service &optional sentinel filter)
+ "Initiate connection to a TCP connection for a service to a host.
+ It returns nil if non-blocking connects are not supported; otherwise,
+ it returns a subprocess-object to represent the connection.
+
+ This function is similar to `open-network-stream', except that this
+ function returns before the connection is established. When the
+ connection is completed, the sentinel function will be called with
+ second arg matching `open' (if successful) or `failed' (on error).
+
+ Args are NAME BUFFER HOST SERVICE SENTINEL FILTER.
+ NAME, BUFFER, HOST, and SERVICE are as for `open-network-stream'.
+ Optional args, SENTINEL and FILTER specifies the sentinel and filter
+ functions to be used for this network stream."
+ (if (make-network-process :feature :nowait t)
+ (make-network-process :name name :buffer buffer :nowait t
+ :host host :service service
+ :filter filter :sentinel sentinel)))
+
+ (defun open-network-stream-server (name buffer service &optional sentinel filter)
+ "Create a network server process for a TCP service.
+ It returns nil if server processes are not supported; otherwise,
+ it returns a subprocess-object to represent the server.
+
+ When a client connects to the specified service, a new subprocess
+ is created to handle the new connection, and the sentinel function
+ is called for the new process.
+
+ Args are NAME BUFFER SERVICE SENTINEL FILTER.
+ NAME is name for the server process. Client processes are named by
+ appending the ip-address and port number of the client to NAME.
+ BUFFER is the buffer (or buffer-name) to associate with the server
+ process. Client processes will not get a buffer if a process filter
+ is specified or BUFFER is nil; otherwise, a new buffer is created for
+ the client process. The name is similar to the process name.
+ Third arg SERVICE is name of the service desired, or an integer
+ specifying a port number to connect to. It may also be t to selected
+ an unused port number for the server.
+ Optional args, SENTINEL and FILTER specifies the sentinel and filter
+ functions to be used for the client processes; the server process
+ does not use these function."
+ (if (make-network-process :feature :server t)
+ (make-network-process :name name :buffer buffer
+ :service service :server t :noquery t)))
+
+ )) ;; (fboundp 'make-network-process)
+
+
+ ;; compatibility
+
+ (defun process-kill-without-query (process &optional flag)
+ "Say no query needed if PROCESS is running when Emacs is exited.
+ Optional second argument if non-nil says to require a query.
+ Value is t if a query was formerly required.
+ New code should not use this function; use `process-query-on-exit-flag'
+ or `set-process-query-on-exit-flag' instead."
+ (let ((old (process-query-on-exit-flag process)))
+ (set-process-query-on-exit-flag process nil)
+ old))
;;; Misc
Index: lisp/files.el
===================================================================
RCS file: /cvs/emacs/lisp/files.el,v
retrieving revision 1.552
diff -c -r1.552 files.el
*** lisp/files.el 6 Mar 2002 18:19:43 -0000 1.552
--- lisp/files.el 13 Mar 2002 23:14:04 -0000
***************
*** 3808,3821 ****
(let ((processes (process-list))
active)
(while processes
! (and (memq (process-status (car processes)) '(run stop open))
! (let ((val (process-kill-without-query (car processes))))
! (process-kill-without-query (car processes) val)
! val)
(setq active t))
(setq processes (cdr processes)))
(or (not active)
! (list-processes)
(yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
--- 3808,3819 ----
(let ((processes (process-list))
active)
(while processes
! (and (memq (process-status (car processes)) '(run stop open listen))
! (process-query-on-exit-flag (car processes))
(setq active t))
(setq processes (cdr processes)))
(or (not active)
! (list-processes t)
(yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
Index: lisp/shadowfile.el
===================================================================
RCS file: /cvs/emacs/lisp/shadowfile.el,v
retrieving revision 1.17
diff -c -r1.17 shadowfile.el
*** lisp/shadowfile.el 16 Jul 2001 12:22:59 -0000 1.17
--- lisp/shadowfile.el 13 Mar 2002 23:14:05 -0000
***************
*** 775,784 ****
(let ((processes (process-list))
active)
(while processes
! (and (memq (process-status (car processes)) '(run stop open))
! (let ((val (process-kill-without-query (car processes))))
! (process-kill-without-query (car processes) val)
! val)
(setq active t))
(setq processes (cdr processes)))
(or (not active)
--- 775,782 ----
(let ((processes (process-list))
active)
(while processes
! (and (memq (process-status (car processes)) '(run stop open listen))
! (process-query-on-exit-flag (car processes))
(setq active t))
(setq processes (cdr processes)))
(or (not active)
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Final(?) patch for server sockets and datagram (UDP) support.
2002-03-13 23:19 ` Final(?) " Kim F. Storm
@ 2002-03-14 0:50 ` Al Petrofsky
2002-03-14 9:30 ` Kim F. Storm
2002-03-14 12:42 ` Richard Stallman
2002-03-17 22:02 ` I have installed the " Kim F. Storm
1 sibling, 2 replies; 46+ messages in thread
From: Al Petrofsky @ 2002-03-14 0:50 UTC (permalink / raw)
Cc: emacs-devel, helmut
It's always been a bit confusing that emacs uses the term process for
sockets that have no associated process. That confusion will get a
little worse now that emacs processes will include server and datagram
sockets, which don't even share processes' stream-like nature.
I'm not saying we should rename everything now to fix this, but I
think it would help if the start of the "make-network-process" doc
string immediately disclaimed any relationship to a unix process.
> :host HOST -- HOST is name of the host to connect to, or its IP
> address. If specified for a server process, only clients on that host
> may connect. The symbol `local' specifies the local host.
Don't you mean something like "If specified for a server process, it
must be a valid name or address for the local host, and only clients
connecting to that address will get through"?
> :local ADDRESS -- ADDRESS is the local address used for the
> connection. This parameter is ignored when opening a client process.
> When specified for a server process, the HOST and SERVICE are ignored.
>
> :remote ADDRESS -- ADDRESS is the remote partner's address for the
> connection. This parameter is ignored when opening a server process.
> When specified for a client process, the HOST and SERVICE are ignored.
These seemed pointless until I read the process-contact doc, and the
NEWS. (The format of the address wasn't documented in either
function's doc string.) I don't think it's a good idea to add two
more arguments to make-network-process just so that process-contact is
easier to document. Is there some other point?
-al
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Final(?) patch for server sockets and datagram (UDP) support.
2002-03-14 0:50 ` Al Petrofsky
@ 2002-03-14 9:30 ` Kim F. Storm
2002-03-14 12:42 ` Richard Stallman
1 sibling, 0 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-03-14 9:30 UTC (permalink / raw)
Cc: emacs-devel, helmut
Al Petrofsky <al@petrofsky.org> writes:
> It's always been a bit confusing that emacs uses the term process for
> sockets that have no associated process. That confusion will get a
> little worse now that emacs processes will include server and datagram
> sockets, which don't even share processes' stream-like nature.
I agree that the "tight" coupling with processes sometimes makes it
quite hard to describe the functionality in a natural way. It would
be easier just to say "datagram socket" than "a datagram type network
process" or some such.
However, even with datagram sockets and server sockets, we still use
all (or most) of the *-process-* API functions to control, monitor,
and send and receive data on the socket, so from that POV, I found
that naming the function make-network-PROCESS was really the best
choice.
>
> I'm not saying we should rename everything now to fix this, but I
> think it would help if the start of the "make-network-process" doc
> string immediately disclaimed any relationship to a unix process.
>
> > :host HOST -- HOST is name of the host to connect to, or its IP
> > address. If specified for a server process, only clients on that host
> > may connect. The symbol `local' specifies the local host.
>
> Don't you mean something like "If specified for a server process, it
> must be a valid name or address for the local host, and only clients
> connecting to that address will get through"?
Exactly! Thanks for spotting this.
>
> > :local ADDRESS -- ADDRESS is the local address used for the
> > connection. This parameter is ignored when opening a client process.
> > When specified for a server process, the HOST and SERVICE are ignored.
> >
> > :remote ADDRESS -- ADDRESS is the remote partner's address for the
> > connection. This parameter is ignored when opening a server process.
> > When specified for a client process, the HOST and SERVICE are ignored.
>
> These seemed pointless until I read the process-contact doc, and the
> NEWS. (The format of the address wasn't documented in either
> function's doc string.) I don't think it's a good idea to add two
> more arguments to make-network-process just so that process-contact is
> easier to document. Is there some other point?
Instead of :family/:host/:service, you can actually use :local ADDR
when setting up a server process (when :server t is specified), and
likewise :remote ADDR to setup a client process.
I will add a description of the ADDRESS format to the doc string.
This means that if you use "clone-process" to clone a network process,
i.e. (apply 'make-network-process (process-contact old t)),
it will use the same IP addres and PORT number as the original process
(taken from :local or :remote), rather than looking up the hostname
and service again [which may in some obscure cases result in connecting
to another host or port]!
BTW, I've found a small bug related to this in my patch: When a server
process accepts a connection and creates a new process for it, it must
set the :server parameter to nil in the new process' contact list.
Here is an updated DOC string for make-network-process:
doc: /* Create and return a network server or client process.
Input and output work as for subprocesses; `delete-process' closes it.
Arguments are specified as keyword/argument pairs. The following
arguments are defined:
:name NAME -- NAME is name for process. It is modified if necessary
to make it unique.
:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
with the process. Process output goes at end of that buffer, unless
you specify an output stream or filter function to handle the output.
BUFFER may be also nil, meaning that this process is not associated
with any buffer.
:host HOST -- HOST is name of the host to connect to, or its IP
address. The symbol `local' specifies the local host. If specified
for a server process, it must be a valid name or address for the local
host, and only clients connecting to that address will be accepted.
:service SERVICE -- SERVICE is name of the service desired, or an
integer specifying a port number to connect to. If SERVICE is t,
a random port number is selected for the server.
:family FAMILY -- FAMILY is the address (and protocol) family for the
service specified by HOST and SERVICE. The default address family is
Inet (or IPv4) for the host and port number specified by HOST and
SERVICE. Other address families supported are:
local -- for a local (i.e. UNIX) address specified by SERVICE.
:local ADDRESS -- ADDRESS is the local address used for the connection.
This parameter is ignored when opening a client process. When specified
for a server process, the FAMILY, HOST and SERVICE args are ignored.
:remote ADDRESS -- ADDRESS is the remote partner's address for the
connection. This parameter is ignored when opening a server process.
When specified for a client process, the FAMILY, HOST, and SERVICE are
ignored.
The format of ADDRESS depends on the address family:
- An IPv4 address is represented as an vector of integers [A B C D P]
corresponding to numeric IP address A.B.C.D and port number P.
- A local address is represented as a string with the address in the
local address space.
- An "unsupported family" address is represented by a cons (F . AV)
where F is the family number and AV is a vector containing the socket
address data with one element per address data byte. Do not rely on
this format in portable code, as it may depend on implementation
defined constants, data sizes, and data structure alignment.
:datagram BOOL -- Create a datagram type connection if BOOL is
non-nil. Default is a stream type connection.
:nowait BOOL -- If BOOL is non-nil for a stream type client process,
return without waiting for the connection to complete; instead, the
sentinel function will be called with second arg matching "open" (if
successful) or "failed" when the connect completes. Default is to use
a blocking connect (i.e. wait) for stream type connections.
:noquery BOOL -- Query the user unless BOOL is non-nil, and process is
running when emacs is exited.
:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
In the stopped state, a server process does not accept new
connections, and a client process does not handle incoming traffic.
The stopped state is cleared by `continue-process' and set by
`stop-process'.
:filter FILTER -- Install FILTER as the process filter.
:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
:log LOG -- Install LOG as the server process log function. This
function is called as when the server accepts a network connection from a
client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
is the server process, CLIENT is the new process for the connection,
and MESSAGE is a string.
:server BOOL -- if BOOL is non-nil, create a server process for the
specified FAMILY, SERVICE, and connection type (stream or datagram).
Default is a client process.
A server process will listen for and accept connections from
clients. When a client connection is accepted, a new network process
is created for the connection with the following parameters:
- The client's process name is constructed by concatenating the server
process' NAME and a client identification string.
- If the FILTER argument is non-nil, the client process will not get a
separate process buffer; otherwise, the client's process buffer is a newly
created buffer named after the server process' BUFFER name or process
NAME concatenated with the client identification string.
- The connection type and the process filter and sentinel parameters are
inherited from the server process' TYPE, FILTER and SENTINEL.
- The client process' contact info is set according to the client's
addressing information (typically an IP address and a port number).
Notice that the FILTER and SENTINEL args are never used directly by
the server process. Also, the BUFFER argument is not used directly by
the server process, but via `network-server-log-function' hook, a log
of the accepted (and failed) connections may be recorded in the server
process' buffer.
The following special call returns t iff a given KEY VALUE
pair is supported on this system:
(make-network-process :feature KEY VALUE) */)
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Final(?) patch for server sockets and datagram (UDP) support.
2002-03-14 0:50 ` Al Petrofsky
2002-03-14 9:30 ` Kim F. Storm
@ 2002-03-14 12:42 ` Richard Stallman
2002-03-14 13:35 ` Kim F. Storm
1 sibling, 1 reply; 46+ messages in thread
From: Richard Stallman @ 2002-03-14 12:42 UTC (permalink / raw)
Cc: storm, emacs-devel, helmut
It's always been a bit confusing that emacs uses the term process for
sockets that have no associated process. That confusion will get a
little worse now that emacs processes will include server and datagram
sockets, which don't even share processes' stream-like nature.
In principle, you are right, but practically speaking it would be a
lot of work to change this. I see no simple name word that does
clearly fit process-or-stream-or-network-port, so any alternative
would have its own drawbacks, even if they are lesser drawbacks.
Meanwhile, working with process objects is a fairly advanced part of
Emacs Lisp programming. I think the people who write such programs
can cope with a suboptimal name.
I'm not saying we should rename everything now to fix this, but I
think it would help if the start of the "make-network-process" doc
string immediately disclaimed any relationship to a unix process.
That would be a good idea.
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* Re: Final(?) patch for server sockets and datagram (UDP) support.
2002-03-14 12:42 ` Richard Stallman
@ 2002-03-14 13:35 ` Kim F. Storm
0 siblings, 0 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-03-14 13:35 UTC (permalink / raw)
Cc: emacs-devel, helmut
Richard Stallman <rms@gnu.org> writes:
>
> I'm not saying we should rename everything now to fix this, but I
> think it would help if the start of the "make-network-process" doc
> string immediately disclaimed any relationship to a unix process.
>
> That would be a good idea.
>
I've added this to the doc string:
In emacs, network connections are represented by process objects, so
input and output work as for subprocesses and `delete-process' closes
a network connection. However, a network process has no process id,
it cannot be signalled, and the status codes are different from normal
processes.
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
* I have installed the patch for server sockets and datagram (UDP) support.
2002-03-13 23:19 ` Final(?) " Kim F. Storm
2002-03-14 0:50 ` Al Petrofsky
@ 2002-03-17 22:02 ` Kim F. Storm
1 sibling, 0 replies; 46+ messages in thread
From: Kim F. Storm @ 2002-03-17 22:02 UTC (permalink / raw)
I installed my changes in CVS.
See etc/NEWS and doc for make-network-process for details.
--
Kim F. Storm <storm@cua.dk> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 46+ messages in thread
end of thread, other threads:[~2002-03-17 22:02 UTC | newest]
Thread overview: 46+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
[not found] <m2u1sa7819.fsf@xaital.online-marketwatch.com>
2002-02-21 23:45 ` Non-blocking open-network-stream Kim F. Storm
2002-02-22 16:04 ` Stefan Monnier
2002-02-25 22:38 ` Kim F. Storm
2002-02-26 22:46 ` Helmut Eller
2002-02-27 11:59 ` Kim F. Storm
2002-02-28 4:08 ` Richard Stallman
2002-03-01 0:21 ` Kim F. Storm
2002-03-01 8:01 ` Juanma Barranquero
2002-03-01 10:50 ` Kim F. Storm
2002-03-01 17:10 ` Pavel Janík
2002-03-01 21:23 ` Richard Stallman
2002-03-07 0:08 ` New patch for server sockets and datagram (UDP) support Kim F. Storm
2002-03-07 10:56 ` Kim F. Storm
2002-03-07 11:39 ` Alex Schroeder
2002-03-07 12:39 ` Kim F. Storm
2002-03-07 14:51 ` Alex Schroeder
2002-03-08 21:06 ` Richard Stallman
2002-03-13 15:56 ` Kim F. Storm
2002-03-13 23:19 ` Final(?) " Kim F. Storm
2002-03-14 0:50 ` Al Petrofsky
2002-03-14 9:30 ` Kim F. Storm
2002-03-14 12:42 ` Richard Stallman
2002-03-14 13:35 ` Kim F. Storm
2002-03-17 22:02 ` I have installed the " Kim F. Storm
2002-03-07 15:18 ` New " Helmut Eller
2002-03-07 16:09 ` Kim F. Storm
2002-03-07 17:32 ` Helmut Eller
2002-03-07 23:58 ` Kim F. Storm
2002-03-08 7:38 ` Helmut Eller
2002-03-08 9:13 ` Kim F. Storm
2002-03-08 11:16 ` Helmut Eller
2002-03-08 16:36 ` Stefan Monnier
2002-03-08 20:57 ` Kim F. Storm
2002-03-08 21:03 ` Stefan Monnier
2002-03-08 21:07 ` Richard Stallman
2002-03-13 15:12 ` Kim F. Storm
2002-03-07 12:54 ` Mario Lang
2002-03-07 12:58 ` Kim F. Storm
2002-03-08 9:09 ` Richard Stallman
2002-03-08 9:35 ` Kim F. Storm
2002-03-08 11:04 ` Helmut Eller
2002-03-02 7:59 ` Non-blocking open-network-stream Helmut Eller
2002-03-03 0:12 ` Kim F. Storm
2002-03-03 10:46 ` Helmut Eller
2002-03-03 16:44 ` Mario Lang
2002-03-03 14:39 ` Richard Stallman
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).