Branch data Line data Source code
1 : : !F90 ISO_C_BINDING wrapper for socket communication.
2 : : !MG got it from https://github.com/i-pi/i-pi/tree/master/drivers
3 : :
4 : : !Copyright (C) 2013, Michele Ceriotti
5 : :
6 : : !Permission is hereby granted, free of charge, to any person obtaining
7 : : !a copy of this software and associated documentation files (the
8 : : !"Software"), to deal in the Software without restriction, including
9 : : !without limitation the rights to use, copy, modify, merge, publish,
10 : : !distribute, sublicense, and/or sell copies of the Software, and to
11 : : !permit persons to whom the Software is furnished to do so, subject to
12 : : !the following conditions:
13 : :
14 : : !The above copyright notice and this permission notice shall be included
15 : : !in all copies or substantial portions of the Software.
16 : :
17 : : !THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
18 : : !EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
19 : : !MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
20 : : !IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
21 : : !CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
22 : : !TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
23 : : !SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
24 : :
25 : :
26 : : !Contains both the functions that transmit data to the socket and read the data
27 : : !back out again once finished, and the function which opens the socket initially.
28 : :
29 : : !Functions:
30 : : ! open_socket: Opens a socket with the required host server, socket type and port number.
31 : : ! write_buffer: Writes a string to the socket.
32 : : ! read_buffer: Reads data from the socket.
33 : :
34 : : #if defined HAVE_CONFIG_H
35 : : #include "config.h"
36 : : #endif
37 : :
38 : : MODULE m_fsockets
39 : :
40 : : use, intrinsic :: iso_c_binding
41 : :
42 : : IMPLICIT NONE
43 : :
44 : : INTERFACE writebuffer
45 : : MODULE PROCEDURE writebuffer_s, writebuffer_d, writebuffer_dv, writebuffer_i
46 : : END INTERFACE writebuffer
47 : :
48 : : INTERFACE readbuffer
49 : : MODULE PROCEDURE readbuffer_s, readbuffer_dv, readbuffer_d, readbuffer_i
50 : : END INTERFACE readbuffer
51 : :
52 : : INTERFACE
53 : : SUBROUTINE open_csocket(psockfd, inet, port, host) BIND(C, name="open_socket")
54 : : use, intrinsic :: iso_c_binding
55 : : INTEGER(KIND=C_INT) :: psockfd, inet, port
56 : : CHARACTER(KIND=C_CHAR), DIMENSION(*) :: host
57 : : END SUBROUTINE open_csocket
58 : :
59 : : SUBROUTINE writebuffer_csocket(psockfd, pdata, plen) BIND(C, name="writebuffer")
60 : : use, intrinsic :: iso_c_binding
61 : : INTEGER(KIND=C_INT) :: psockfd
62 : : TYPE(C_PTR), VALUE :: pdata
63 : : INTEGER(KIND=C_INT) :: plen
64 : : END SUBROUTINE writebuffer_csocket
65 : :
66 : : SUBROUTINE readbuffer_csocket(psockfd, pdata, plen) BIND(C, name="readbuffer")
67 : : use, intrinsic :: iso_c_binding
68 : : INTEGER(KIND=C_INT) :: psockfd
69 : : TYPE(C_PTR), VALUE :: pdata
70 : : INTEGER(KIND=C_INT) :: plen
71 : : END SUBROUTINE readbuffer_csocket
72 : : END INTERFACE
73 : :
74 : : CONTAINS
75 : :
76 : 0 : SUBROUTINE open_socket(psockfd, inet, port, host)
77 : : INTEGER, INTENT(IN) :: inet, port
78 : : INTEGER, INTENT(OUT) :: psockfd
79 : : CHARACTER(LEN=1024), INTENT(IN) :: host
80 : : CHARACTER(LEN=1,KIND=C_CHAR) :: chost(1024)
81 : :
82 : 0 : CALL fstr2cstr(host, chost)
83 : 0 : CALL open_csocket(psockfd, inet, port, host)
84 : 0 : END SUBROUTINE open_socket
85 : :
86 [ # # ]: 0 : SUBROUTINE fstr2cstr(fstr, cstr, plen)
87 : : CHARACTER(LEN=*), INTENT(IN) :: fstr
88 : : CHARACTER(LEN=1,KIND=C_CHAR), INTENT(OUT) :: cstr(:)
89 : : INTEGER, INTENT(IN), OPTIONAL :: plen
90 : :
91 : : INTEGER i,n
92 [ # # ]: 0 : IF (PRESENT(plen)) THEN
93 : 0 : n = plen
94 [ # # ]: 0 : DO i=1,n
95 : 0 : cstr(i) = fstr(i:i)
96 : : ENDDO
97 : : ELSE
98 : 0 : n = LEN_TRIM(fstr)
99 [ # # ]: 0 : DO i=1,n
100 : 0 : cstr(i) = fstr(i:i)
101 : : ENDDO
102 : 0 : cstr(n+1) = C_NULL_CHAR
103 : : END IF
104 : 0 : END SUBROUTINE fstr2cstr
105 : :
106 : 0 : SUBROUTINE writebuffer_d (psockfd, fdata)
107 : : use, intrinsic :: iso_c_binding
108 : : INTEGER, INTENT(IN) :: psockfd
109 : : REAL(KIND=8), INTENT(IN) :: fdata
110 : :
111 : : REAL(KIND=C_DOUBLE), TARGET :: cdata
112 : :
113 : 0 : cdata = fdata
114 : 0 : CALL writebuffer_csocket(psockfd, c_loc(cdata), 8)
115 : 0 : END SUBROUTINE writebuffer_d
116 : :
117 : 0 : SUBROUTINE writebuffer_i (psockfd, fdata)
118 : : use, intrinsic :: iso_c_binding
119 : : INTEGER, INTENT(IN) :: psockfd, fdata
120 : :
121 : : INTEGER(KIND=C_INT), TARGET :: cdata
122 : :
123 : 0 : cdata = fdata
124 : 0 : CALL writebuffer_csocket(psockfd, c_loc(cdata), 4)
125 : 0 : END SUBROUTINE writebuffer_i
126 : :
127 : 0 : SUBROUTINE writebuffer_s (psockfd, fstring, plen)
128 : : use, intrinsic :: iso_c_binding
129 : : INTEGER, INTENT(IN) :: psockfd
130 : : CHARACTER(LEN=*), INTENT(IN) :: fstring
131 : : INTEGER, INTENT(IN) :: plen
132 : :
133 : : INTEGER :: i
134 : 0 : CHARACTER(LEN=1, KIND=C_CHAR), TARGET :: cstring(plen)
135 : :
136 [ # # ]: 0 : DO i = 1,plen
137 : 0 : cstring(i) = fstring(i:i)
138 : : ENDDO
139 : 0 : CALL writebuffer_csocket(psockfd, c_loc(cstring(1)), plen)
140 : 0 : END SUBROUTINE writebuffer_s
141 : :
142 : 0 : SUBROUTINE writebuffer_dv(psockfd, fdata, plen)
143 : : use, intrinsic :: iso_c_binding
144 : : INTEGER, INTENT(IN) :: psockfd, plen
145 : : REAL(KIND=8), INTENT(IN), TARGET :: fdata(plen)
146 : :
147 : 0 : CALL writebuffer_csocket(psockfd, c_loc(fdata(1)), 8*plen)
148 : 0 : END SUBROUTINE writebuffer_dv
149 : :
150 : 0 : SUBROUTINE readbuffer_d (psockfd, fdata)
151 : : use, intrinsic :: iso_c_binding
152 : : INTEGER, INTENT(IN) :: psockfd
153 : : REAL(KIND=8), INTENT(OUT) :: fdata
154 : :
155 : : REAL(KIND=C_DOUBLE), TARGET :: cdata
156 : :
157 : 0 : CALL readbuffer_csocket(psockfd, c_loc(cdata), 8)
158 : 0 : fdata=cdata
159 : 0 : END SUBROUTINE readbuffer_d
160 : :
161 : 0 : SUBROUTINE readbuffer_i (psockfd, fdata)
162 : : use, intrinsic :: iso_c_binding
163 : : INTEGER, INTENT(IN) :: psockfd
164 : : INTEGER, INTENT(OUT) :: fdata
165 : :
166 : : INTEGER(KIND=C_INT), TARGET :: cdata
167 : :
168 : 0 : CALL readbuffer_csocket(psockfd, c_loc(cdata), 4)
169 : 0 : fdata = cdata
170 : 0 : END SUBROUTINE readbuffer_i
171 : :
172 : 0 : SUBROUTINE readbuffer_s (psockfd, fstring, plen)
173 : : use, intrinsic :: iso_c_binding
174 : : INTEGER, INTENT(IN) :: psockfd
175 : : CHARACTER(LEN=*), INTENT(OUT) :: fstring
176 : : INTEGER, INTENT(IN) :: plen
177 : :
178 : : INTEGER :: i
179 : 0 : CHARACTER(LEN=1, KIND=C_CHAR), TARGET :: cstring(plen)
180 : :
181 : 0 : CALL readbuffer_csocket(psockfd, c_loc(cstring(1)), plen)
182 [ # # ]: 0 : fstring=""
183 [ # # ]: 0 : DO i = 1,plen
184 : 0 : fstring(i:i) = cstring(i)
185 : : ENDDO
186 : 0 : END SUBROUTINE readbuffer_s
187 : :
188 : 0 : SUBROUTINE readbuffer_dv(psockfd, fdata, plen)
189 : : use, intrinsic :: iso_c_binding
190 : : INTEGER, INTENT(IN) :: psockfd, plen
191 : : REAL(KIND=8), INTENT(OUT), TARGET :: fdata(plen)
192 : :
193 : 0 : CALL readbuffer_csocket(psockfd, c_loc(fdata(1)), 8*plen)
194 : 0 : END SUBROUTINE readbuffer_dv
195 : :
196 : 0 : SUBROUTINE socket_from_string (srvaddress, socket)
197 : : CHARACTER(len=*), INTENT(IN) :: srvaddress
198 : : integer, INTENT(out) :: socket
199 : 0 : CHARACTER(len=len_trim(srvaddress)) :: address
200 : : INTEGER :: port, inet, field_sep_pos
201 : :
202 : : ! Parses host name, port and socket type
203 : 0 : field_sep_pos = INDEX(srvaddress, ':', back=.true.)
204 [ # # # # ]: 0 : address = srvaddress(1:field_sep_pos-1)
205 : :
206 : : ! Check if UNIX type socket
207 [ # # ]: 0 : IF (trim(srvaddress(field_sep_pos+1 :)) == 'UNIX') then
208 : 0 : port = 1234 ! just a place-holder
209 : 0 : inet = 0
210 : : !write(*,*) " Connecting to `", trim(address), "` using UNIX socket"
211 : : ELSE
212 : 0 : read ( srvaddress ( field_sep_pos+1 : ), * ) port
213 : 0 : inet = 1
214 : : !write(*,*) " Connecting to `", trim(address), ":", srvaddress (field_sep_pos+1:), " using INET socket"
215 : : END IF
216 : :
217 : : ! Create the socket
218 [ # # ]: 0 : CALL open_socket (socket, inet, port, trim(address)//achar(0))
219 : :
220 : 0 : END SUBROUTINE socket_from_string
221 : :
222 : 0 : END MODULE m_fsockets
|
