PageRenderTime 60ms CodeModel.GetById 25ms RepoModel.GetById 0ms app.codeStats 0ms

/pLibrary/System/Socket/socket.sa

https://bitbucket.org/starware/sather
Unknown | 365 lines | 318 code | 47 blank | 0 comment | 0 complexity | 619d3e47e9dbb17dd42f0fcc7d8cff1f MD5 | raw file
Possible License(s): GPL-3.0, LGPL-3.0
  1. -------------------------> GNU Sather - sourcefile <-------------------------
  2. -- Copyright (C) 199x by International Computer Science Institute --
  3. -- This file is part of the GNU Sather library. It is free software; you may --
  4. -- redistribute and/or modify it under the terms of the GNU Library General --
  5. -- Public License (LGPL) as published by the Free Software Foundation; --
  6. -- either version 3 of the license, or (at your option) any later version. --
  7. -- This library is distributed in the hope that it will be useful, but --
  8. -- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
  9. -- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details. --
  10. -- The license text is also available from: Free Software Foundation, Inc., --
  11. -- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --
  12. --------------> Please email comments to <bug-sather@gnu.org> <--------------
  13. -- socket.sa
  14. -- Author: David Bailey <dbailey@icsi.berkeley.edu>
  15. -- January 1993 Sather 0.2 version
  16. -- April 1995 Sather 1.0 version
  17. -- December 1995 Sather 1.0.9 pSather version
  18. -- June 1996 Sather 1.1 version unifying serial and parallel using "PP"
  19. -- and introducing exceptions.
  20. --------------------------------------------------------------------
  21. -- Bidirectional communication of strings between processes (intra-
  22. -- or inter-machine) using Unix sockets. Blocking reads, potentially
  23. -- blocking writes.
  24. --
  25. -- Classes: SOCKET, SOCKET_EXCEPTION, C_SOCKET
  26. -- Required file: socket_support.c
  27. --
  28. -- Tested on (p)Sather 1.1 under SunOS 4 and 5. No guarantees beyond that.
  29. -- NO INTERNAL ERROR MESSAGES SHOULD APPEAR IN USE;
  30. -- PLEASE REPORT ANY OCCURRENCES.
  31. --
  32. -- Bug: In rare circumstances, killing a process that is initiating a
  33. -- Unix socket may leave behind a file which will have to be manually
  34. -- removed before another socket can be initiated with the same name.
  35. -- Such files reside in the directory indicated in `unix_socket_directory'.
  36. --
  37. -- Idea: Add error codes to the interface.
  38. -- Idea: Non-blocking socket creation as suggested by Cliff Draper.
  39. --
  40. ----------------------------------------------------------------------
  41. class SOCKET is
  42. -- Bidirectional communication of strings between processes (intra-
  43. -- or inter-machine) using sockets. Blocking reads, potentially
  44. -- blocking writes.
  45. -- Four versions of create, distinguishing: (1) Unix-domain (intra-machine)
  46. -- vs. Internet-domain (inter-machine); and (2) initiating vs. connecting.
  47. -- "Dead" sockets may be returned if the passed name or port is
  48. -- already in use (initiating side), or if no matching initiator was
  49. -- found within `num_connect_attempts' seconds (connecting side), if
  50. -- an invalid `hostname' is given (connecting side), or in anomalous
  51. -- circumstances (in which case a message appears on stderr).
  52. create_initiating_unix(name:STR):SAME pre void(self) is
  53. -- Initate a SOCKET named `name', then block until another
  54. -- process does a 'create_connecting_unix' with the same name,
  55. -- on the same machine. `name' must be a legal Unix filename.
  56. -- Upon error, return a dead socket.
  57. lock when shared_mutex then
  58. res::=new;
  59. res.mutex:=#MUTEX; --S:
  60. if ~reasonable_filename(name) then
  61. res.is_dead_var:=true; return res
  62. end;
  63. res.id:=C_SOCKET::
  64. make_initiating_socket_unix(unix_socket_directory+name);
  65. if res.id<0 then res.is_dead_var:=true end;
  66. C_SOCKET::ignore_broken_pipe_signals;
  67. return res
  68. end -- lock
  69. end;
  70. create_connecting_unix(name:STR):SAME pre void(self) is
  71. -- Connect to an existing Unix-domain SOCKET named `name'.
  72. -- Will try once per second up to 10 seconds.
  73. -- `name' must be a legal Unix filename. Upon error, return a
  74. -- dead socket.
  75. res::=new;
  76. res.mutex:=#MUTEX; --S:
  77. if ~reasonable_filename(name) then
  78. res.is_dead_var:=true; return res
  79. end;
  80. res.id:=
  81. C_SOCKET::make_connecting_socket_unix(unix_socket_directory+name);
  82. if res.id<0 then res.is_dead_var:=true end;
  83. C_SOCKET::ignore_broken_pipe_signals;
  84. return res
  85. end;
  86. create_initiating_inet(port:INT):SAME pre void(self) is
  87. -- Initate an Internet SOCKET on port `port', then block until
  88. -- another process does a 'create_connecting_inet' to this port.
  89. -- `port' must be >= `min_port_num'. Upon error, return a dead socket.
  90. res::=new;
  91. res.mutex:=#MUTEX; --S:
  92. if port<min_port_num then res.is_dead_var:=true; return res end;
  93. res.id:=C_SOCKET::make_initiating_socket_inet(port);
  94. if res.id<0 then res.is_dead_var:=true end;
  95. C_SOCKET::ignore_broken_pipe_signals; -- need even in inet case
  96. return res
  97. end;
  98. create_connecting_inet(host:STR,port:INT):SAME pre void(self) is
  99. -- Connect to an existing Internet SOCKET on port `port' of
  100. -- machine `host'. Will try once per second up to 10 seconds.
  101. -- `port' must be >= `min_port_num'. Upon error, return a dead socket.
  102. res::=new;
  103. res.mutex:=#MUTEX; --S:
  104. if port<min_port_num then res.is_dead_var:=true; return res end;
  105. res.id:=C_SOCKET::make_connecting_socket_inet(host,port);
  106. if res.id<0 then res.is_dead_var:=true end;
  107. C_SOCKET::ignore_broken_pipe_signals; -- need even in inet case
  108. return res
  109. end;
  110. close is
  111. -- Close the socket and mark it dead. Hopefully, by using this,
  112. -- programs using Internet sockets can avoid the "lingering
  113. -- socket" phenomenon...
  114. lock when mutex then
  115. C_SOCKET::close_socket(id);
  116. is_dead_var:=true
  117. end -- lock
  118. end;
  119. use_exceptions(b:BOOL) is
  120. -- Turn on or off the raising of a SOCKET_EXCEPTION when either
  121. -- (1) the socket dies due to external factors (usually
  122. -- termination of the peer socket's process) in the course of
  123. -- any operation other than an explicit `is_dead' check; or
  124. -- (2) a caller attempts to read or write using an already closed
  125. -- or dead socket. Note that in any case, `is_dead' will be set
  126. -- when a socket dies or is closed. If exceptions are turned on
  127. -- when the socket is already dead, an exception is raised.
  128. lock when mutex then
  129. use_exceptions_var:=b;
  130. if use_exceptions_var and is_dead_var then
  131. raise #SOCKET_EXCEPTION("Socket dead upon turning on exceptions")
  132. end
  133. end -- lock
  134. end;
  135. is_using_exceptions:BOOL is
  136. -- Report whether this socket uses exceptions as described above.
  137. lock when mutex then
  138. return use_exceptions_var
  139. end -- lock
  140. end;
  141. is_dead:BOOL is
  142. -- Indicates whether the socket is alive and capable of
  143. -- performing a `get_str' or `plus'.
  144. lock when mutex then
  145. -- NOTE: Not sure if is_healthy=0 catches all cases where the
  146. -- socket is effectively dead but has not yet failed.
  147. if ~is_dead_var and (C_SOCKET::is_healthy(id)=0) then close end;
  148. return is_dead_var
  149. end -- lock
  150. end;
  151. get_str:STR pre ~void(self) is
  152. -- Return the next string from the peer SOCKET.
  153. -- An empty-string result means the sender sent EITHER the empty
  154. -- string or a void string.
  155. -- May block, if no strings are available, until one is sent.
  156. -- If an error occurs, the socket dies, and return void.
  157. -- If socket is already dead: raise an exception if using exceptions,
  158. -- else simply return void.
  159. lock when mutex then
  160. if is_dead_var then
  161. if use_exceptions_var then
  162. raise #SOCKET_EXCEPTION("Tried to read from a dead socket")
  163. end;
  164. return void
  165. end;
  166. res:STR;
  167. len::=C_SOCKET::receive_len(id);
  168. if len>0 then
  169. res:="X".repeat(len);
  170. status::=C_SOCKET::receive_str(id,res,len);
  171. if status=0 then
  172. die("Socket died receiving body of string");
  173. res:=void
  174. end
  175. elsif len=0 then res:=#STR
  176. else die("Socket died receiving length of string")
  177. end;
  178. return res
  179. end -- lock
  180. end;
  181. plus(s:$STR) pre ~void(self) is
  182. -- Send string version of `s' to the peer SOCKET.
  183. -- If 's' is void, the receiver will get the empty string.
  184. -- May block, if buffers are full, until receiver does a `get_str'.
  185. -- If an error occurs, the socket dies.
  186. -- If socket is already dead: raise an exception if using exceptions,
  187. -- else simply return.
  188. lock when mutex then
  189. if is_dead_var then
  190. if use_exceptions_var then
  191. raise #SOCKET_EXCEPTION("Tried to write on a dead socket")
  192. end;
  193. return
  194. end;
  195. str_to_send:STR;
  196. if void(s) then str_to_send:="" else str_to_send:=s.str end;
  197. if (C_SOCKET::is_healthy(id)=0) then
  198. die("Socket found dead when preparing to send string");
  199. return
  200. end;
  201. status::=C_SOCKET::send_str(id,str_to_send,str_to_send.length);
  202. if status=0 then die("Socket died while sending string") end
  203. end -- lock
  204. end;
  205. plus(s:$STR):SAME is plus(s); return self end;
  206. -- Same as above except return self, allowing chaining, eg, skt+x+y+z.
  207. can_read_without_block:BOOL pre ~void(self) is
  208. -- Return true if socket is alive and data is available
  209. -- so that `get_str' would not block.
  210. lock when mutex then
  211. return ~is_dead_var and C_SOCKET::able_to_read(id)/=0
  212. end -- lock
  213. end;
  214. can_write_without_block:BOOL pre ~void(self) is
  215. -- Return true if socket is alive and 'plus' would accept a
  216. -- string without blocking due to full buffers.
  217. lock when mutex then
  218. return ~is_dead_var and C_SOCKET::able_to_write(id)/=0
  219. end -- lock
  220. end;
  221. block_until_can_read pre ~void(self) is
  222. -- Blocks in a non-busy wait until socket can read.
  223. -- If socket is already dead: raise an exception if using exceptions,
  224. -- else return immediately.
  225. lock when mutex then
  226. if is_dead_var then
  227. if use_exceptions_var then
  228. raise #SOCKET_EXCEPTION("Tried to block_until_can_read on a "
  229. "dead socket")
  230. end;
  231. return
  232. end;
  233. C_SOCKET::block_until_can_read(id)
  234. end -- lock
  235. end;
  236. block_until_can_write pre ~void(self) is
  237. -- Blocks in a non-busy wait until socket can write without blocking.
  238. -- If socket is already dead: raise an exception if using exceptions,
  239. -- else return immediately.
  240. lock when mutex then
  241. if is_dead_var then
  242. if use_exceptions_var then
  243. raise #SOCKET_EXCEPTION("Tried to block_until_can_write on a "
  244. "dead socket")
  245. end;
  246. return
  247. end;
  248. C_SOCKET::block_until_can_write(id)
  249. end -- lock
  250. end;
  251. reasonable_filename(s:STR):BOOL is
  252. -- Return whether `s' is a reasonable Unix filename and hence
  253. -- suitable for a Unix-domain socket name. Overly cautious, but
  254. -- this ought to be implemented elsewhere anyway.
  255. loop
  256. c::=s.elt!;
  257. if ~c.is_alphanum and c/='-' and c/='_' and c/='.' then
  258. return false
  259. end
  260. end;
  261. return true
  262. end;
  263. min_port_num:INT is return C_SOCKET::min_port_num end;
  264. -- Internet socket port numbers must exceed this value.
  265. private die(s:STR) is
  266. -- Close the socket (thereby marking it dead), and raise an
  267. -- exception if use_exceptions_var is set.
  268. close;
  269. if use_exceptions_var then raise #SOCKET_EXCEPTION(s) end
  270. end;
  271. private attr id:INT;
  272. -- Unix descriptor for the socket.
  273. private attr is_dead_var:BOOL;
  274. -- Indicates whether socket is operational for `get_str' or `plus'.
  275. private attr use_exceptions_var:BOOL;
  276. -- Flag whether to raise an exception under the conditions described
  277. -- in the routine `use_exceptions'.
  278. private attr mutex:MUTEX; --S:
  279. -- Used to ensure each SOCKET is handling only 1 routine at a time. --S:
  280. --
  281. shared num_connect_attempts:INT:=10;
  282. -- Connecting sockets will look once per second for a matching
  283. -- initator, this many times, before failing.
  284. shared unix_socket_directory:STR:="/tmp/";
  285. -- Where Unix-domain server sockets will live.
  286. -- Probably should leave this alone; but if you must change it at
  287. -- runtime, be sure to change it in both communicating processes!
  288. private shared shared_mutex:MUTEX:=MUTEX::create; --S:
  289. -- Used to ensure that, globally, only one create_initiating_unix --S:
  290. -- runs at a time. (Needed because of the way that routine handles --S:
  291. -- signals.) --S:
  292. end;
  293. ----------------------------------------------------------------------
  294. class SOCKET_EXCEPTION < $STR is
  295. create(s:STR):SAME is res::=new; res.s:=s; return res end;
  296. str:STR is return "SOCKET_EXCEPTION: "+s end;
  297. private attr s:STR;
  298. end;
  299. ----------------------------------------------------------------------
  300. ----------------------------------------------------------------------
  301. external class C_SOCKET is
  302. make_initiating_socket_unix(name:STR):INT;
  303. make_connecting_socket_unix(name:STR):INT;
  304. make_initiating_socket_inet(port:INT):INT;
  305. make_connecting_socket_inet(srvname:STR,srvport:INT):INT;
  306. close_socket(fd:INT);
  307. receive_len(id:INT):INT;
  308. receive_str(id:INT,s:STR,len:INT):INT; -- modifies s
  309. send_str(id:INT,s:STR,len:INT):INT;
  310. able_to_read(fd:INT):INT;
  311. able_to_write(fd:INT):INT;
  312. is_healthy(fd:INT):INT;
  313. block_until_can_read(fd:INT);
  314. block_until_can_write(fd:INT);
  315. min_port_num:INT;
  316. ignore_broken_pipe_signals;
  317. nconnatt:INT is return SOCKET::num_connect_attempts end;
  318. end;