/Library/System/Socket/experimental/socket.sa

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