1 ;;; liece-tcp.el --- TCP/IP stream emulation.
2 ;; Copyright (C) 1998-2000 Daiki Ueno
4 ;; Author: Masanobu Umeda <umerin@mse.kyutech.ac.jp>
5 ;; Daiki Ueno <ueno@unixuser.org>
6 ;; Created: 1999-03-16 renamed from tcp.el
7 ;; Keywords: IRC, liece
9 ;; This file is part of Liece.
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 ;; Notes on TCP package:
30 ;; This package provides a TCP/IP stream emulation for GNU Emacs. If
31 ;; the function `open-network-stream' is not defined in Emacs, but
32 ;; your operating system has a capability of network stream
33 ;; connection, this tcp package can be used for communicating with
36 ;; The tcp package runs inferior process which actually does the role
37 ;; of `open-network-stream'. The program `tcp' provided with this
38 ;; package can be used for such purpose. Before loading the package,
39 ;; compile `tcp.c' and install it as `tcp' in a directory in the emacs
40 ;; search path. If you modify `tcp.c', please send diffs to the author
41 ;; of GNUS. I'll include some of them in the next releases.
49 (require 'liece-compat)
50 (require 'liece-globals))
52 (defgroup liece-tcp nil
58 (defcustom liece-tcp-program "ltcp"
59 "The name of the program emulating `open-network-stream' function."
63 (defcustom liece-tcp-default-connection-type 'network
64 "TCP/IP Connection type."
66 (const :tag "Network" network)
67 (const :tag "Program" program)
68 (const :tag "SSLeay" ssl)
69 (const :tag "rlogin" rlogin))
72 (defvar liece-tcp-connection-type liece-tcp-default-connection-type)
75 (autoload 'open-ssl-stream "ssl")
76 (defvar ssl-program-arguments))
78 (defcustom liece-tcp-ssl-protocol-version "3"
79 "SSL protocol version."
83 (defcustom liece-tcp-ssl-default-service 993
84 "Default SSL service."
85 :type 'liece-service-spec
88 (defcustom liece-tcp-rlogin-program "rsh"
89 "Program used to log in on remote machines.
90 The default is \"rsh\", but \"ssh\" is a popular alternative."
94 (defcustom liece-tcp-relay-host "localhost"
95 "Remote host address."
99 (defcustom liece-tcp-rlogin-parameters '("socket" "-q")
100 "Parameters to `liece-tcp-open-rlogin'."
104 (defcustom liece-tcp-rlogin-user-name nil
105 "User name on remote system when using the rlogin connect method."
109 (defvar liece-tcp-stream-alist
110 '((network open-network-stream)
111 (program liece-tcp-open-program-stream)
112 (ssl liece-tcp-open-ssl-stream)
113 (rlogin liece-tcp-open-rlogin-stream)))
117 (defun liece-open-network-stream (name buffer host service)
119 (nth 1 (assq liece-tcp-connection-type
120 liece-tcp-stream-alist))))
122 (error "Invalid stream"))
123 (funcall method name buffer host service)))
125 (defun liece-tcp-open-program-stream (name buffer host service)
126 "Open a TCP connection for a service to a host.
127 Returns a subprocess-object to represent the connection.
128 Input and output work as for subprocesses; `delete-process' closes it.
129 Args are NAME BUFFER HOST SERVICE.
130 NAME is name for process. It is modified if necessary to make it unique.
131 BUFFER is the buffer (or `buffer-name') to associate with the process.
132 Process output goes at end of that buffer, unless you specify
133 an output stream or filter function to handle the output.
134 BUFFER may be also nil, meaning that this process is not associated
136 Third arg is name of the host to connect to.
137 Fourth arg SERVICE is name of the service desired, or an integer
138 specifying a service number to connect to."
139 (let ((proc (start-process name buffer
142 (if (stringp service)
144 (int-to-string service)))))
145 (process-kill-without-query proc)
149 (defun liece-tcp-open-ssl-stream-1 (name buffer server service extra-arg)
150 (let* ((service (or service liece-tcp-ssl-default-service))
151 (ssl-program-arguments (list extra-arg "-connect"
152 (format "%s:%d" server service)))
153 (process (open-ssl-stream name buffer server service)))
154 (and process (memq (process-status process) '(open run))
157 (defun liece-tcp-open-ssl-stream (name buffer server service)
158 (if (string-equal liece-tcp-ssl-protocol-version "2")
159 (liece-tcp-open-ssl-stream-1
160 name buffer server service "-ssl2")
161 (or (liece-tcp-open-ssl-stream-1
162 name buffer server service "-ssl3")
163 (liece-tcp-open-ssl-stream-1
164 name buffer server service "-ssl2"))))
166 (defun liece-tcp-open-rlogin-stream (name buffer server service)
167 "Open a connection to SERVER using rsh."
168 (let* ((service (if (stringp service)
170 (int-to-string service)))
171 (args `(,liece-tcp-rlogin-program
172 ,@(if liece-tcp-rlogin-user-name
173 (list "-l" liece-tcp-rlogin-user-name))
174 ,liece-tcp-relay-host
175 ,@liece-tcp-rlogin-parameters ,server ,service))
176 (process-connection-type nil))
177 (apply #'start-process-shell-command name buffer args)))
181 ;;; liece-tcp.el ends here