/Library/System/Socket/experimental/socket.sa
Unknown | 652 lines | 419 code | 233 blank | 0 comment | 0 complexity | 097683458767abb1d26628152b807c0f MD5 | raw file
Possible License(s): GPL-3.0, LGPL-3.0
- class SOCKET is
- -- This class implements bidirectional communication of strings between
- -- processes (intra- or inter-machine) using sockets. Both reads and writes
- -- may block waiting for the other process to rendezvous.
- -- There are four versions of socket creation - initiating and
- -- connecting sockets for either a local machine socket or for an Internet
- -- one! Dead sockets may be returned if the name or port arguments are
- -- already in use (when initiating) or if no matching initiator was found
- -- within num_connect_attempts seconds (when attempting to connect) or if
- -- an invalid hostname is given (when attempting to connect) or in anomalous
- -- circumstances (in which case a message appears on stderr).
- -- NOTE This version is an interim fix until integrated into the new Network
- -- library.!!!!!
-
- -- Version 1.5 May 99. Copyright K Hopper, U of Waikato
- -- Development History
- -- -------------------
- -- Date Who By Detail
- -- ---- ------ ------
- -- 8 Jan 93 db Original for Sather 0.2
- -- 14 Apr 95 db Revised for 1.0
- -- 12 Dec 95 db Revised for 1.0.9
- -- 4 Jun 96 db Revised for 1.1
- -- 14 May 99 mdb Now communicates with non-Sather sockets!
- -- 16 May 99 kh Interim re-write
- private const Packet_Size : INT := 1518 ; -- Ethernet max!
- private attr id : INT ; -- Unix descriptor for socket.
-
- private attr is_dead_var : BOOL ; -- Indicates if socket operational
-
- private attr use_exceptions_var : BOOL ;
- -- This indicates whether an exception is to be raised when failure
- -- occurs.
- shared num_connect_attempts : INT := 10 ;
- -- Connecting sockets will look once per second for a matching initiator
- -- this many times before failing.
- shared unix_socket_directory : STR := "/tmp/" ;
- -- This is the name of the directory where unix-domain server sockets are
- -- to be created.
- min_port_num : INT is
- -- This routine returns the minimum port number established by the
- -- underlying socket interface.
- return C_SOCKET::min_port_num
- end ;
-
- reasonable_filename(
- name : STR
- ) : BOOL is
- -- This routine is provided to test whether the given name is a
- -- reasonable unix-style file name. [This will disappear when the new
- -- required library is adopted.]
- loop
- loc_ch : CHAR := name.elt! ;
-
- if ~loc_ch.is_alphanum
- and loc_ch /= '-'
- and loc_ch /= '_'
- and loc_ch /= '.' then
- return false
- end
- end ;
-
- return true
- end ;
- create_initiating_unix(
- name : STR
- ) : SAME
- pre void(self)
- post result.is_dead_var
- or (result.id /= 0)
- is
-
- -- This routine attempts to initiate a new socket with the given name.
- -- It then blocks until another process creates a connecting socket with the
- -- same name on the same machine. The name argument must be a legal Unix
- -- filename. If an error occurs then a dead socket is returned.
- res : SAME := new ;
-
- if ~reasonable_filename(name) then
- res.is_dead_var := true ;
- return res
- end ;
-
- res.id := C_SOCKET::make_initiating_socket_unix(
- unix_socket_directory + name) ;
-
- if res.id < INT::zero then -- creation failed!
- res.is_dead_var := true
- end ;
-
- C_SOCKET::ignore_broken_pipe_signals ; -- tell the OS!
-
- return res
- end ;
-
- create_connecting_unix(
- name : STR
- ) : SAME
- pre void(self)
- post result.is_dead_var
- or (result.id /= 0)
- is
-
- -- This routine attempts to connect to an existing unix-domain socket
- -- with the given name. Attempts will be made once per second up to
- -- num_connect_attempts seconds. The name argument must be a legal unix
- -- filename. If an error occurs then the socket returned is dead!
- res : SAME := new ;
-
- if ~reasonable_filename(name) then
- res.is_dead_var := true ;
- return res
- end ;
-
- res.id := C_SOCKET::make_connecting_socket_unix(
- unix_socket_directory + name) ;
-
- if res.id < INT::zero then -- failed!
- res.is_dead_var := true
- end ;
-
- C_SOCKET::ignore_broken_pipe_signals ; -- tell OS - ????????
-
- return res
- end ;
- create_initiating_inet(
- port : INT
- ) : SAME
- pre void(self)
- and (port >= min_port_num)
- post result.is_dead_var
- or (result.id /= 0)
- is
- -- This routine initiates a local Internet socket on the given port, then
- -- blocks until another process does a 'create_connecting_inet' to this port.
- -- If an error occurs then a dead socket is returned.
- res : SAME := new ;
-
- res.id := C_SOCKET::make_initiating_socket_inet(port) ;
-
- if res.id < INT::zero then
- res.is_dead_var := true
- end ;
-
- C_SOCKET::ignore_broken_pipe_signals ; -- needed even in inet case ?????
-
- return res
- end ;
-
- create_connecting_inet(
- host : STR,
- port : INT
- ) : SAME
- pre void(self)
- and (port >= min_port_num)
- post result.is_dead_var
- or (result.id /= 0)
- is
-
- -- This routine attempts to connect to an existing Internet socket on
- -- the given port of the named host. Attempts will be made once per second
- -- for num_connect_attempts seconds. If an error occurs then a dead socket
- -- is returned.
- res : SAME := new ;
-
- res.id := C_SOCKET::make_connecting_socket_inet(host,port) ;
-
- if res.id < INT::zero then
- res.is_dead_var := true
- end ;
-
- C_SOCKET::ignore_broken_pipe_signals ; -- needed even in inet case ?????
-
- return res
- end ;
- close
- pre ~void(self)
- and (id /= 0)
- post is_dead_var
- is
-
- -- Thsi routine closes the socket and marks it dead.
- C_SOCKET::close_socket(id) ;
- is_dead_var := true
- end ;
-
- use_exceptions(
- val : BOOL
- )
- pre ~void(self)
- and ~is_dead_var
- post (use_exceptions_var = val)
- is
-
- -- This routine provides the facility to turn on the raising of an
- -- exception when I/O failure occurs if the argument is true, turning it off
- -- if the argument is false. The circumstances under which an exception will
- -- be raised are :-
- --
- -- (1) the socket dies due to external factors (usually termination of
- -- the peer socket's process) in the course of any operation other than
- -- an explicit `is_dead' check.
- --
- -- (2) a caller attempts to read or write using an already closed or
- -- dead socket. Note that in any case, `is_dead' will be set when a
- -- socket dies or is closed.
- --
- -- If exceptions are turned on when the socket is already dead, an exception
- -- is raised.
- use_exceptions_var := val
- end ;
-
- is_using_exceptions : BOOL is
- -- This predicate returns true if and only if this socket is using
- -- exception raising in the event of an error occurring.
- return use_exceptions_var
- end ;
-
- is_dead : BOOL is
- -- This predicate returns true if and only if this socket is alive and
- -- able to communicate with its peer.
-
- -- NOTE The routine is_healthy should catch all cases where the socket is
- -- effectively dead but has not yet failed.
- if ~is_dead_var
- and (C_SOCKET::is_healthy(id) = 0) then
- close
- end ;
-
- return is_dead_var
- end ;
- can_read_without_block : BOOL
- pre ~void(self)
- post true
- is
- -- This predicate returns true if and only if the socket is alive and
- -- data is available such that get_str will not block.
- return ~is_dead_var
- and (C_SOCKET::able_to_read(id) /= 0)
- end ;
- can_write_without_block : BOOL
- pre ~void(self)
- post true
- is
- -- This predicate returns true if and only if the socket is alive and
- -- writing will not block due to full buffers.
- return ~is_dead_var
- and (C_SOCKET::able_to_write(id) /= 0)
-
- end ;
- private die(
- msg : STR
- ) is
-
- -- This private routine closes the socket (thereby marking it dead) and
- -- raises an exception if use_exceptions_var is true.
- close ;
-
- if use_exceptions_var then
- raise SOCKET_EXCEPTION::create(msg)
- end
- end ;
-
- get_str : STR
- pre ~void(self)
- and ~is_dead_var
- post true
- is
- -- This routine returns the next text string from the peer socket. If
- -- an empty string is returned then the sender may have sent a void string.
- -- If no string is available this routine will block until one is received.
- -- Should the socket die during communication then void is returned
- res : STR ;
- buff : STR ;
- count : INT := Packet_Size ;
- length : INT := INT::zero ;
- loop
- while!(count = Packet_Size) ;
- buff := "X".repeat(Packet_Size) ;
- count := C_SOCKET::receive_str(id,buff,Packet_Size) ;
-
- if count = -1 then -- an error has occurred!
- die("Socket died while sending string") ;
- return void
- elsif count > 0 then
- length := length + count ;
- res := res.plus(buff.head(count))
- end
- end ;
- if length = INT::zero then -- so create a void one!
- res := STR::create
- end ;
-
- return res
- end ;
-
- plus(
- str : $STR
- )
- pre ~void(self)
- and ~is_dead_var
- and ~void(str)
- post true
- is
- -- This routine appends str to the socket connected to self. If the
- -- buffer is full then this routine will block until the receiving process
- -- retrieves the string. If an error occurs then the socket dies!
- str_to_send : STR := str.str ;
- if (C_SOCKET::is_healthy(id) = INT::zero) then -- already dead!
- die("Socket found dead when preparing to send string") ;
- return
- end ;
-
- status : INT := C_SOCKET::send_str(id,str_to_send,str_to_send.size) ;
-
- if status = 0 then
- die("Socket died while sending string")
- end
- end ;
- plus(
- str : $STR
- ) : SAME
- pre ~void(self)
- and ~is_dead_var
- and ~void(str)
- post true
- is
- -- This routine appends the string to the socket and then returns self.
- plus(str) ;
- return self
- end ;
- block_until_can_read
- pre ~void(self)
- and ~is_dead_var
- post can_read_without_block
- is
- -- This routine blocks in a non-busy wait until this socket can be read.
- C_SOCKET::block_until_can_read(id)
- end ;
- block_until_can_write
- pre ~void(self)
- and ~is_dead_var
- post can_write_without_block
- is
- -- This routine blocks in a non-busy wait until the socket can be
- -- written to without blocking.
- C_SOCKET::block_until_can_write(id)
- end ;
- end ; -- SOCKET
-
- ------------------------------------------------------------------------------
- class SOCKET_EXCEPTION is -- < $STR is
- -- This class implements an oboslescent exceptiin facility for use by
- -- the SOCKET class pending incorporation into the new Network library.
- -- Version 1.1 May 99. Copyright K Hopper, U of Waikato
- -- Development History
- -- -------------------
- -- Date Who By Detail
- -- ---- ------ ------
- -- 8 Jan 93 db Original for Sather 0.2
- -- 16 May 99 kh Revised style for interim use.
- private attr msg : STR ;
- create(
- str : STR
- ) : SAME is
- -- This routine returns a new object with the associated message.
- res : SAME := new ;
- res.msg := str ;
- return res
- end ;
-
- str : STR is
- -- This routine returns a string message indicating the error.
- return "SOCKET_EXCEPTION: " + msg
- end ;
- end ; -- SOCKET_EXCEPTION
- ------------------------------------------------------------------------------
- external C class C_SOCKET is
- -- This class defines the interface between the Sather socket class and
- -- the run-time support facility. This is for interim use pending the issue
- -- of the new Network library.
-
- -- Version 1.1 May 99. Copyright K Hopper, U of Waikato
- -- Development History
- -- -------------------
- -- Date Who By Detail
- -- ---- ------ ------
- -- 8 Jan 93 db Original for Sather 0.2
- -- 16 May 99 kh Revised for interim use.
- min_port_num : INT ;
- -- This routine returns the number which indicates the minimum port
- -- number which may be opened on the current machine.
- ignore_broken_pipe_signals ;
- -- This routine requests the operating system socket mechanism to ignore
- -- any broken pipe signals in respect of this process/thread.
- make_initiating_socket_unix(
- name : STR
- ) : INT ;
- -- This routine creates an initiating local unix socket. It returns the
- -- handle to the socket (or -1 if an error has occurred).
- make_connecting_socket_unix(
- name : STR
- ) : INT ;
- -- This routine creates a connecting local unix socket. It returns the
- -- handle to the socket (or -1 if an error has occurred).
-
- make_initiating_socket_inet(
- port : INT
- ) : INT ;
-
- -- This routine creates an initiating local internet socket. It returns
- -- the handle to the socket (or -1 if an error has occurred).
- make_connecting_socket_inet(
- server_name : STR,
- server_port : INT
- ) : INT ;
- -- This routine creates a connecting remote unix socket on the given
- -- port on the indicated network server/host. It returns the handle to the
- -- socket (or -1 if an error has occurred).
-
- close_socket(
- socket_handle : INT
- ) ;
- -- This routine closes the external socket to which self is attached.
- receive_str(
- socket_handle : INT,
- str : STR,
- length : INT
- ) : INT ;
- -- This routine attempts to read a string from the indicated socket into
- -- the given buffer up to size length, returning either the length actually
- -- read or -1 if an error has occurred.
- send_str(
- socket_handle : INT,
- str : STR,
- length : INT
- ) : INT ;
- -- This routine appends the given string (of the given length) to the
- -- indicated socket attached to self.
-
- able_to_read(
- socket_handle : INT
- ) : INT ;
- -- This predicate returns 1 if the socket indicated may be read without
- -- blocking, otherwise zero.
- able_to_write(
- socket_handle : INT
- ) : INT ;
- -- This predicate returns 1 if the socket indicated may be written to
- -- without blocking, otherwise zero.
- is_healthy(
- socket_handle : INT
- ) : INT ;
- -- This routine returns 1 if and only if the socket indicated is not
- -- dead.
- block_until_can_read(
- socket_handle : INT
- ) ;
- -- This routine makes the calling thread wait (in a non-busy manner)
- -- until the indicated socket can be read.
- block_until_can_write(
- socket_handle : INT
- ) ;
- -- This routine makes the calling thread wait (in a non-busy manner)
- -- until the indicated socket can be written to.
- nconnatt : INT is
- -- This interface routine is a 'call-back' from the OS socket mechanism
- -- to find out the number of connection attempts to make!
- return SOCKET::num_connect_attempts
- end ;
- end ; -- C_SOCKET