Mercurial > hg > xemacs-beta

comparison src/process.c @ 5814:a216b3c2b09e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add TLS support. See xemacs-patches message with ID <CAHCOHQk6FNm2xf=XiGEpPq43+7WOzNZ=SuD9V79o3wb9WVCTrQ@mail.gmail.com>.
author Jerry James <james@xemacs.org>
date Tue, 07 Oct 2014 21:16:10 -0600
parents 3192994c49ca
children d93195c2c906
comparison
equal deleted inserted replaced
5813:36dddf9d90d1 5814:a216b3c2b09e
140 #define MARKED_SLOT(x) mark_object (process->x); 140 #define MARKED_SLOT(x) mark_object (process->x);
141 #include "process-slots.h" 141 #include "process-slots.h"
142 return Qnil; 142 return Qnil;
143 } 143 }
144 144
145 static int
146 tls_connection_p (Lisp_Object process)
147 {
148 Lisp_Process *p = XPROCESS (process);
149 Lstream *in = XLSTREAM (DATA_INSTREAM (p));
150 Lstream *out = XLSTREAM (DATA_OUTSTREAM (p));
151 return Lstream_tls_p (in) || Lstream_tls_p (out);
152 }
153
145 static void 154 static void
146 print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 155 print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
147 { 156 {
148 Lisp_Process *process = XPROCESS (obj); 157 Lisp_Process *process = XPROCESS (obj);
149 158
155 print_internal (process->name, printcharfun, 0); 164 print_internal (process->name, printcharfun, 0);
156 } 165 }
157 else 166 else
158 { 167 {
159 int netp = network_connection_p (obj); 168 int netp = network_connection_p (obj);
169 int tlsp = netp && tls_connection_p (obj);
160 write_ascstring (printcharfun, 170 write_ascstring (printcharfun,
161 netp ? GETTEXT ("#<network connection ") : 171 tlsp ? GETTEXT ("#<tls network connection ") :
162 GETTEXT ("#<process ")); 172 (netp ? GETTEXT ("#<network connection ") :
173 GETTEXT ("#<process ")));
163 print_internal (process->name, printcharfun, 1); 174 print_internal (process->name, printcharfun, 1);
164 write_ascstring (printcharfun, (netp ? " " : " pid ")); 175 write_ascstring (printcharfun, (netp ? " " : " pid "));
165 print_internal (process->pid, printcharfun, 1); 176 print_internal (process->pid, printcharfun, 1);
166 write_fmt_string_lisp (printcharfun, " state:%S", 1, process->status_symbol); 177 write_fmt_string_lisp (printcharfun, " state:%S", 1, process->status_symbol);
167 MAYBE_PROCMETH (print_process_data, (process, printcharfun)); 178 MAYBE_PROCMETH (print_process_data, (process, printcharfun));
842 exactly like a normal process when reading and writing. Only 853 exactly like a normal process when reading and writing. Only
843 differences are in status display and process deletion. A network 854 differences are in status display and process deletion. A network
844 connection has no PID; you cannot signal it. All you can do is 855 connection has no PID; you cannot signal it. All you can do is
845 deactivate and close it via delete-process */ 856 deactivate and close it via delete-process */
846 857
847 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 858 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 6,
848 0, /* 859 0, /*
849 Open a TCP connection for a service to a host. 860 Open a TCP connection for a service to a host.
850 Return a process object to represent the connection. 861 Return a process object to represent the connection.
851 Input and output work as for subprocesses; `delete-process' closes it. 862 Input and output work as for subprocesses; `delete-process' closes it.
852 863
861 Fourth arg SERVICE is the name of the service desired (a string), 872 Fourth arg SERVICE is the name of the service desired (a string),
862 or an integer specifying a port number to connect to. 873 or an integer specifying a port number to connect to.
863 Optional fifth arg PROTOCOL is a network protocol. Currently only `tcp' 874 Optional fifth arg PROTOCOL is a network protocol. Currently only `tcp'
864 (Transmission Control Protocol) and `udp' (User Datagram Protocol) are 875 (Transmission Control Protocol) and `udp' (User Datagram Protocol) are
865 supported. When omitted, `tcp' is assumed. 876 supported. When omitted, `tcp' is assumed.
877 Optional sixth arg TLS is a boolean. If it is NIL, a standard network stream
878 is opened. If it is non-NIL, a TLS network stream is opened if TLS support
879 is available; otherwise an error is signaled.
866 880
867 Output via `process-send-string' and input via buffer or filter (see 881 Output via `process-send-string' and input via buffer or filter (see
868 `set-process-filter') are stream-oriented. That means UDP datagrams are 882 `set-process-filter') are stream-oriented. That means UDP datagrams are
869 not guaranteed to be sent and received in discrete packets. (But small 883 not guaranteed to be sent and received in discrete packets. (But small
870 datagrams around 500 bytes that are not truncated by `process-send-string' 884 datagrams around 500 bytes that are not truncated by `process-send-string'
871 are usually fine.) Note further that the UDP protocol does not guard 885 are usually fine.) Note further that the UDP protocol does not guard
872 against lost packets. 886 against lost packets.
873 */ 887 */
874 (name, buffer, host, service, protocol)) 888 (name, buffer, host, service, protocol, tls))
875 { 889 {
876 /* This function can GC */ 890 /* This function can GC */
877 Lisp_Object process = Qnil; 891 Lisp_Object process = Qnil;
878 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1; 892 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1;
879 void *inch, *outch; 893 void *inch, *outch;
894 int flags;
880 895
881 GCPRO5 (name, buffer, host, service, protocol); 896 GCPRO5 (name, buffer, host, service, protocol);
882 CHECK_STRING (name); 897 CHECK_STRING (name);
883 898
884 if (NILP (protocol)) 899 if (NILP (protocol))
887 CHECK_SYMBOL (protocol); 902 CHECK_SYMBOL (protocol);
888 903
889 /* Since this code is inside HAVE_SOCKETS, existence of 904 /* Since this code is inside HAVE_SOCKETS, existence of
890 open_network_stream is mandatory */ 905 open_network_stream is mandatory */
891 PROCMETH (open_network_stream, (name, host, service, protocol, 906 PROCMETH (open_network_stream, (name, host, service, protocol,
892 &inch, &outch)); 907 &inch, &outch, !NILP(tls)));
893 908
894 if (!NILP (buffer)) 909 if (!NILP (buffer))
895 buffer = Fget_buffer_create (buffer); 910 buffer = Fget_buffer_create (buffer);
896 process = make_process_internal (name); 911 process = make_process_internal (name);
897 NGCPRO1 (process); 912 NGCPRO1 (process);
898 913
899 XPROCESS (process)->pid = Fcons (service, host); 914 XPROCESS (process)->pid = Fcons (service, host);
900 XPROCESS (process)->buffer = buffer; 915 XPROCESS (process)->buffer = buffer;
916 flags = STREAM_NETWORK_CONNECTION;
917 if (!NILP (tls))
918 flags |= STREAM_USE_TLS;
901 init_process_io_handles (XPROCESS (process), (void *) inch, (void *) outch, 919 init_process_io_handles (XPROCESS (process), (void *) inch, (void *) outch,
902 (void *) -1, 920 (void *) -1, flags);
903 STREAM_NETWORK_CONNECTION);
904 921
905 event_stream_select_process (XPROCESS (process), 1, 1); 922 event_stream_select_process (XPROCESS (process), 1, 1);
906 923
907 NUNGCPRO; 924 NUNGCPRO;
908 UNGCPRO; 925 UNGCPRO;
909 return process; 926 return process;
927 }
928
929 DEFUN ("tls-negotiate", Ftls_negotiate, 3, 3, 0, /*
930 "Negotiate a SSL/TLS connection. Returns PROCESS if negotiation is
931 successful, NIL otherwise.
932
933 PROCESS is a process returned by `open-network-stream'.
934 HOSTNAME is the remote hostname. It must be a valid string.
935 KEYLIST is an alist of (client key file, client cert file) pairs.
936 */
937 (process, hostname, keylist))
938 {
939 Lisp_Process *p;
940 Lstream *in, *out;
941 Extbyte *ext_host;
942
943 CHECK_PROCESS (process);
944 CHECK_STRING (hostname);
945 p = XPROCESS (process);
946 in = XLSTREAM (DATA_INSTREAM (p));
947 out = XLSTREAM (DATA_OUTSTREAM (p));
948 ext_host = LISP_STRING_TO_EXTERNAL (hostname, Qunix_host_name_encoding);
949 return Lstream_tls_negotiate (in, out, ext_host, keylist) ? process : Qnil;
910 } 950 }
911 951
912 #ifdef HAVE_MULTICAST 952 #ifdef HAVE_MULTICAST
913 953
914 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* 954 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /*
2599 DEFSUBR (Fprocess_kill_without_query_p); 2639 DEFSUBR (Fprocess_kill_without_query_p);
2600 DEFSUBR (Fprocess_list); 2640 DEFSUBR (Fprocess_list);
2601 DEFSUBR (Fstart_process_internal); 2641 DEFSUBR (Fstart_process_internal);
2602 #ifdef HAVE_SOCKETS 2642 #ifdef HAVE_SOCKETS
2603 DEFSUBR (Fopen_network_stream_internal); 2643 DEFSUBR (Fopen_network_stream_internal);
2644 DEFSUBR (Ftls_negotiate);
2604 #ifdef HAVE_MULTICAST 2645 #ifdef HAVE_MULTICAST
2605 DEFSUBR (Fopen_multicast_group_internal); 2646 DEFSUBR (Fopen_multicast_group_internal);
2606 #endif /* HAVE_MULTICAST */ 2647 #endif /* HAVE_MULTICAST */
2607 #endif /* HAVE_SOCKETS */ 2648 #endif /* HAVE_SOCKETS */
2608 DEFSUBR (Fprocess_send_region); 2649 DEFSUBR (Fprocess_send_region);