Mercurial > hg > xemacs-beta
diff src/process.c @ 259:11cf20601dec r20-5b28
Import from CVS: tag r20-5b28
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:23:02 +0200 |
parents | 65c19d2020f7 |
children | 727739f917cb |
line wrap: on
line diff
--- a/src/process.c Mon Aug 13 10:22:10 2007 +0200 +++ b/src/process.c Mon Aug 13 10:23:02 2007 +0200 @@ -23,8 +23,8 @@ /* Synched up with: Mule 2.0, FSF 19.30. */ -/* This file has been Mule-ized except for `start-process-internal' - and `open-network-stream-internal'. */ +/* This file has been Mule-ized except for `start-process-internal', + `open-network-stream-internal' and `open-multicast-group-internal'. */ #include <config.h> @@ -44,8 +44,8 @@ #include "process.h" #include "sysdep.h" #include "window.h" -#ifdef MULE -#include "mule-coding.h" +#ifdef FILE_CODING +#include "file-coding.h" #endif #include <setjmp.h> @@ -65,6 +65,10 @@ /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */ Lisp_Object Qopen, Qclosed; +#ifdef HAVE_MULTICAST +Lisp_Object Qmulticast; /* Will be used for occasional warnings */ +#endif + /* t means use pty, nil means use a pipe, maybe other values to come. */ static Lisp_Object Vprocess_connection_type; @@ -787,7 +791,9 @@ filedesc_stream_set_pty_flushing (XLSTREAM (p->outstream), pty_max_bytes, eof_char); } -#ifdef MULE + +#ifdef FILE_CODING + p->instream = make_decoding_input_stream (XLSTREAM (p->instream), Fget_coding_system (Vcoding_system_for_read)); @@ -797,7 +803,7 @@ Fget_coding_system (Vcoding_system_for_write)); /* CODE_CNTL (&out_state[outchannel]) |= CC_END; !!#### What's going on here? */ -#endif /* MULE */ +#endif } static void @@ -1505,6 +1511,231 @@ return proc; } +#ifdef HAVE_MULTICAST +/* Didier Verna <verna@inf.enst.fr> Nov. 28 1997. + + This function is similar to open-network-stream-internal, but provides a + mean to open an UDP multicast connection instead of a TCP one. Like in the + TCP case, the multicast connection will be seen as a sub-process, + + Some notes: + - Normaly, we should use sendto and recvfrom with non connected + sockets. The current code doesn't allow us to do this. In the future, it + would be a good idea to extend the process data structure in order to deal + properly with the different types network connections. + - For the same reason, when leaving a multicast group, it is better to make + a setsockopt - IP_DROP_MEMBERSHIP before closing the descriptors. + Unfortunately, this can't be done here because delete_process doesn't know + about the kind of connection we have. However, this is not such an + important issue. +*/ +DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* +Open a multicast connection on the specified dest/port/ttl. +Returns a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. + +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 also be nil, meaning that this process is not associated + with any buffer. +Third, fourth and fifth args are the multicast destination group, port and ttl. + dest must be an internet address between 224.0.0.0 and 239.255.255.255 + port is a communication port like in traditional unicast + ttl is the time-to-live (15 for site, 63 for region and 127 for world) +*/ + (name, buffer, dest, port, ttl)) +{ + /* !!#### This function has not been Mule-ized */ + /* This function can GC */ + Lisp_Object proc; + struct ip_mreq imr; + struct sockaddr_in sa; + struct protoent *udp; + int ws, rs; + int theport; + unsigned char thettl; + int one = 1; /* For REUSEADDR */ + int ret; + volatile int retry = 0; + struct gcpro gcpro1; + + CHECK_STRING (name); + CHECK_STRING (dest); + + CHECK_NATNUM (port); + theport = htons ((unsigned short) XINT (port)); + + CHECK_NATNUM (ttl); + thettl = (unsigned char) XINT (ttl); + + if ((udp = getprotobyname ("udp")) == NULL) + error ("No info available for UDP protocol"); + + /* Init the sockets. Yes, I need 2 sockets. I couldn't duplicate one. */ + if ((rs = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0) + report_file_error ("error creating socket", list1(name)); + if ((ws = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0) + { + close (rs); + report_file_error ("error creating socket", list1(name)); + } + + /* This will be used for both sockets */ + bzero(&sa, sizeof(sa)); + sa.sin_family = AF_INET; + sa.sin_port = theport; + sa.sin_addr.s_addr = htonl (inet_addr ((char *) XSTRING_DATA (dest))); + + /* Socket configuration for reading ------------------------ */ + + /* Multiple connections from the same machine. This must be done before + bind. If it fails, it shouldn't be fatal. The only consequence is that + people won't be able to connect twice from the same machine. */ + if (setsockopt (rs, SOL_SOCKET, SO_REUSEADDR, (char *) &one, sizeof (one)) + < 0) + warn_when_safe (Qmulticast, Qwarning, "Cannot reuse socket address"); + + /* bind socket name */ + if (bind (rs, (struct sockaddr *)&sa, sizeof(sa))) + { + close (rs); + close (ws); + report_file_error ("error binding socket", list2(name, port)); + } + + /* join multicast group */ + imr.imr_multiaddr.s_addr = htonl (inet_addr ((char *) XSTRING_DATA (dest))); + imr.imr_interface.s_addr = htonl (INADDR_ANY); + if (setsockopt (rs, IPPROTO_IP, IP_ADD_MEMBERSHIP, + (char *) &imr, sizeof (struct ip_mreq)) < 0) + { + close (ws); + close (rs); + report_file_error ("error adding membership", list2(name, dest)); + } + + /* Socket configuration for writing ----------------------- */ + + /* Normaly, there's no 'connect' in multicast, since we use preferentialy + 'sendto' and 'recvfrom'. However, in order to handle this connection in + the process-like way it is done for TCP, we must be able to use 'write' + instead of 'sendto'. Consequently, we 'connect' this socket. */ + + /* See open-network-stream-internal for comments on this part of the code */ + slow_down_interrupts (); + + loop: + + /* A system call interrupted with a SIGALRM or SIGIO comes back + here, with can_break_system_calls reset to 0. */ + SETJMP (break_system_call_jump); + if (QUITP) + { + speed_up_interrupts (); + REALLY_QUIT; + /* In case something really weird happens ... */ + slow_down_interrupts (); + } + + /* Break out of connect with a signal (it isn't otherwise possible). + Thus you don't get screwed with a hung network. */ + can_break_system_calls = 1; + ret = connect (ws, (struct sockaddr *) &sa, sizeof (sa)); + can_break_system_calls = 0; + if (ret == -1 && errno != EISCONN) + { + int xerrno = errno; + + if (errno == EINTR) + goto loop; + if (errno == EADDRINUSE && retry < 20) + { + /* A delay here is needed on some FreeBSD systems, + and it is harmless, since this retrying takes time anyway + and should be infrequent. + `sleep-for' allowed for quitting this loop with interrupts + slowed down so it can't be used here. Async timers should + already be disabled at this point so we can use `sleep'. */ + sleep (1); + retry++; + goto loop; + } + + close (rs); + close (ws); + speed_up_interrupts (); + + errno = xerrno; + report_file_error ("error connecting socket", list2(name, port)); + } + + speed_up_interrupts (); + + /* scope */ + if (setsockopt (ws, IPPROTO_IP, IP_MULTICAST_TTL, + (char *) &thettl, sizeof (thettl)) < 0) + { + close (rs); + close (ws); + report_file_error ("error setting ttl", list2(name, ttl)); + } + + if (!NILP (buffer)) + buffer = Fget_buffer_create (buffer); + + proc = make_process_internal (name); + GCPRO1 (proc); + + descriptor_to_process[rs] = proc; + +#ifdef PROCESS_IO_BLOCKING + { + Lisp_Object tail; + + for (tail = network_stream_blocking_port_list; + CONSP (tail); tail = XCDR (tail)) + { + Lisp_Object tail_port = XCAR (tail); + + if (STRINGP (tail_port)) + { + struct servent *svc_info; + + svc_info = + getservbyname ((char *) XSTRING_DATA (tail_port), "udp"); + if ((svc_info != 0) && (svc_info->s_port == theport)) + break; + else + continue; + } + else if ((INTP (tail_port)) && + (htons ((unsigned short) XINT (tail_port)) == theport)) + break; + } + + if (!CONSP (tail)) + { +#endif /* PROCESS_IO_BLOCKING */ + set_descriptor_non_blocking (rs); +#ifdef PROCESS_IO_BLOCKING + } + } +#endif /* PROCESS_IO_BLOCKING */ + + XPROCESS (proc)->pid = Fcons (port, dest); + XPROCESS (proc)->buffer = buffer; + init_process_fds (XPROCESS (proc), rs, ws); + XPROCESS (proc)->connected_via_filedesc_p = 0; + + event_stream_select_process (XPROCESS (proc)); + + UNGCPRO; + return proc; +} +#endif /* HAVE_MULTICAST */ + #endif /* HAVE_SOCKETS */ Lisp_Object @@ -1967,7 +2198,7 @@ return Qnil; } -#ifdef MULE +#ifdef FILE_CODING DEFUN ("process-input-coding-system", Fprocess_input_coding_system, 1, 1, 0, /* Return PROCESS's input coding system. @@ -2039,7 +2270,7 @@ return Qnil; } -#endif /* MULE */ +#endif /************************************************************************/ @@ -3257,6 +3488,10 @@ defsymbol (&Qopen, "open"); defsymbol (&Qclosed, "closed"); +#ifdef HAVE_MULTICAST + defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */ +#endif + DEFSUBR (Fprocessp); DEFSUBR (Fget_process); DEFSUBR (Fget_buffer_process); @@ -3281,6 +3516,9 @@ DEFSUBR (Fstart_process_internal); #ifdef HAVE_SOCKETS DEFSUBR (Fopen_network_stream_internal); +#ifdef HAVE_MULTICAST + DEFSUBR (Fopen_multicast_group_internal); +#endif /* HAVE_MULTICAST */ #endif /* HAVE_SOCKETS */ DEFSUBR (Fprocess_send_region); DEFSUBR (Fprocess_send_string); @@ -3292,14 +3530,14 @@ DEFSUBR (Fprocess_send_eof); DEFSUBR (Fsignal_process); /* DEFSUBR (Fprocess_connection); */ -#ifdef MULE +#ifdef FILE_CODING DEFSUBR (Fprocess_input_coding_system); DEFSUBR (Fprocess_output_coding_system); DEFSUBR (Fset_process_input_coding_system); DEFSUBR (Fset_process_output_coding_system); DEFSUBR (Fprocess_coding_system); DEFSUBR (Fset_process_coding_system); -#endif /* MULE */ +#endif } void @@ -3308,7 +3546,10 @@ Fprovide (intern ("subprocesses")); #ifdef HAVE_SOCKETS Fprovide (intern ("network-streams")); -#endif +#ifdef HAVE_MULTICAST + Fprovide (intern ("multicast")); +#endif /* HAVE_MULTICAST */ +#endif /* HAVE_SOCKETS */ staticpro (&Vprocess_list); DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes /*