1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144

------------------------------------------------------------------------------
--- Library to support network programming with sockets that are addressed
--- by symbolic names. In contrast to raw sockets (see library `Socket`),
--- this library uses the Curry Port Name Server
--- to provide sockets that are addressed by symbolic names
--- rather than numbers.
---
--- In standard applications, the server side uses the operations
--- `listenOn` and `socketAccept` to provide some service
--- on a named socket, and the client side uses the operation
--- `connectToSocket` to request a service.
---
--- @author Michael Hanus
--- @version March 2021
------------------------------------------------------------------------------

module Network.NamedSocket
  ( Socket
  , listenOn, socketAccept, waitForSocketAccept
  , connectToSocketRepeat, connectToSocketWait
  , sClose, socketName, connectToSocket
  )
 where

import System.Process ( sleep )
import System.IO      ( Handle )
import qualified Network.Socket as Socket
import Network.CPNS

---------------------------------------------------------------------
-- Server side operations:

--- Abstract type for named sockets.
data Socket = NamedSocket String Socket.Socket

--- Creates a server side socket with a symbolic name.
listenOn :: String -> IO Socket
listenOn socketname = do
  (port,socket) <- Socket.listenOnFresh
  registerPort socketname port 0
  return (NamedSocket socketname socket)

--- Returns a connection of a client to a socket.
--- The connection is returned as a pair consisting of a string identifying
--- the client (the format of this string is implementation-dependent)
--- and a handle to a stream communication with the client.
--- The handle is both readable and writable.
socketAccept :: Socket -> IO (String,Handle)
socketAccept (NamedSocket _ socket) = Socket.accept socket

--- Waits until a connection of a client to a socket is available.
--- If no connection is available within the time limit, it returns Nothing,
--- otherwise the connection is returned as a pair consisting
--- of a string identifying the client
--- (the format of this string is implementation-dependent)
--- and a handle to a stream communication with the client.
--- @param socket - a socket
--- @param timeout - milliseconds to wait for input (< 0 : no time out)
waitForSocketAccept :: Socket -> Int -> IO (Maybe (String,Handle))
waitForSocketAccept (NamedSocket _ socket) = Socket.waitForSocketAccept socket

--- Closes a server socket.
sClose :: Socket -> IO ()
sClose (NamedSocket socketname socket) = do
  Socket.close socket
  unregisterPort socketname

--- Returns a the symbolic name of a named socket.
socketName :: Socket -> String
socketName (NamedSocket socketname _) = socketname

---------------------------------------------------------------------
-- Client side operations:

--- Waits for connection to a Unix socket with a symbolic name.
--- In contrast to `connectToSocket`, this action waits until
--- the socket has been registered with its symbolic name.
--- @param waittime - the time to wait before retrying (in milliseconds)
--- @param action   - I/O action to be executed before each wait cycle
--- @param retries  - number of retries before giving up (-1 = retry forever)
--- @param nameAtHost - the symbolic name of the socket
---                     (must be either of the form "name@host" or "name"
---                      where the latter is a shorthand for "name@localhost")
--- @return Nothing (if connection is not possible within the given limits)
---         or (Just h) where h is the handle of the connection
connectToSocketRepeat :: Int -> IO _ -> Int -> String -> IO (Maybe Handle)
connectToSocketRepeat waittime action retries nameAtHost = do
  let (name,atHost) = break (=='@') nameAtHost
      host = if atHost=="" then "localhost" else tail atHost
  -- check whether remote CPNS demon is alive:
  alive <- cpnsAlive host
  if not alive
    then tryAgain
    else do -- get remote socket/port numbers:
      (snr,_) <- getPortInfo name host
      if snr==0
       then tryAgain
       else Socket.connectToSocket host snr >>= return . Just
 where
  tryAgain = if retries==0 then return Nothing else do
    action
    sleep (ms2s waittime)
    connectToSocketRepeat waittime action (decr retries) nameAtHost

  ms2s n = let mn = n `div` 1000 in if mn==0 then 1 else mn

  decr n = if n<0 then n else n-1


--- Waits for connection to a Unix socket with a symbolic name and
--- return the handle of the connection.
--- This action waits (possibly forever) until the socket with the symbolic
--- name is registered.
--- @param nameAtHost - the symbolic name of the socket
---                     (must be either of the form "name@host" or "name"
---                      where the latter is a shorthand for "name@localhost")
--- @return the handle of the connection (connected to the socket nameAtHost)
---         which is both readable and writable
connectToSocketWait :: String -> IO Handle
connectToSocketWait nameAtHost = do
  Just hdl <- connectToSocketRepeat 1000 (return ()) (-1) nameAtHost
  return hdl

--- Creates a new connection to an existing(!) Unix socket with a symbolic
--- name. If the symbolic name is not registered, an error is reported.
--- @param nameAtHost - the symbolic name of the socket
---                     (must be either of the form "name@host" or "name"
---                      where the latter is a shorthand for "name@localhost")
--- @return the handle of the stream (connected to the socket nameAtHost)
---         which is both readable and writable
connectToSocket :: String -> IO Handle
connectToSocket nameAtHost = do
  let (name,atHost) = break (=='@') nameAtHost
      host = if atHost=="" then "localhost" else tail atHost
  -- get remote port number:
  (snr,_) <- getPortInfo name host
  if snr==0
    then error ("connectToSocket: Socket \""++name++"@"++host++
                "\" is not registered!")
    else return ()
  Socket.connectToSocket host snr


---------------------------------------------------------------------