aboutsummaryrefslogtreecommitdiff
path: root/network.F90
diff options
context:
space:
mode:
authorJeffrey Armstrong <jeff@approximatrix.com>2020-04-30 17:58:35 -0400
committerJeffrey Armstrong <jeff@approximatrix.com>2020-04-30 17:58:35 -0400
commit690395a50cd55401a9cfee598638bef482d164bd (patch)
tree03528ccef371ee6a268715ae12de009d7032dce0 /network.F90
parent537ff39898992c3915bcf01e3840becc6750520f (diff)
downloadLR-87-690395a50cd55401a9cfee598638bef482d164bd.zip
LR-87-690395a50cd55401a9cfee598638bef482d164bd.tar.gz
Fixed initialization of windows networking. Fixed some overruns in hostent processing.
Diffstat (limited to 'network.F90')
-rw-r--r--network.F90207
1 files changed, 207 insertions, 0 deletions
diff --git a/network.F90 b/network.F90
new file mode 100644
index 0000000..2130841
--- /dev/null
+++ b/network.F90
@@ -0,0 +1,207 @@
+module network
+use iso_c_binding
+implicit none
+
+ integer(kind=c_int), parameter::AF_INET = 2
+ integer(kind=c_int), parameter::AF_INET6 = 10
+ integer(kind=c_int), parameter::AF_UNIX = 1
+
+ integer(kind=c_int), parameter::SOCK_STREAM = 1
+
+#ifdef WINDOWS
+ integer, parameter::hostent_int_kind = c_short
+#else
+ integer, parameter::hostent_int_kind = c_int
+#endif
+
+ type, bind(c) :: in_addr
+ integer(kind=c_int32_t)::s_addr
+ end type
+
+ type, bind(c) :: sockaddr_in
+ integer(kind=c_short)::sin_family
+ integer(kind=c_int16_t)::sin_port
+ type(in_addr)::sin_addr
+ !integer(kind=c_int32_t)::s_addr
+ end type
+
+ type, bind(c) :: hostent_c
+ type(c_ptr)::h_name !official name of host */
+ type(c_ptr)::h_aliases !alias list */
+ integer(kind=hostent_int_kind):: h_addrtype !host address type */
+ integer(kind=hostent_int_kind):: h_length !length of address */
+ type(c_ptr)::h_addr_list !list of addresses */
+ end type
+
+ ! Let's keep this simple...
+ type :: simple_hostent
+ character(len=:), allocatable::h_name
+ integer::h_addrtype
+ integer(kind=c_int32_t)::h_addr4
+ integer(kind=c_int64_t)::h_addr6
+ end type
+
+ integer(kind=c_size_t), parameter::sockaddr_size = 56
+
+ interface
+ function socket_c(i, j, k) bind(c, name="socket")
+ use iso_c_binding
+ integer(kind=c_int), value::i, j, k
+ integer(kind=c_int)::socket_c
+ end function socket_c
+
+ function inet_addr_c(str) bind(c, name="inet_addr")
+ use iso_c_binding
+ type(c_ptr), value::str
+ integer(c_int32_t)::inet_addr_c
+ end function inet_addr_c
+
+ function htons(i) bind(c)
+ use iso_c_binding
+ integer(kind=c_int32_t), value::i
+ integer(kind=c_int32_t)::htons
+ end function htons
+
+ function connect_c(sockfd, sock_addr, socklen) bind(c, name="connect")
+ use iso_c_binding
+ import::sockaddr_in
+ integer(kind=c_int), value::sockfd
+ type(c_ptr), value::sock_addr
+ integer(kind=c_size_t), value::socklen
+ integer(kind=c_int)::connect_c
+ end function connect_c
+
+ function gethostbyname_c(host) bind(c, name="gethostbyname")
+ use iso_c_binding
+ type(c_ptr), value::host
+ type(c_ptr)::gethostbyname_c
+ end function gethostbyname_c
+
+ end interface
+
+ contains
+
+ function socket(domain, stype, protocol)
+ use iso_c_binding, only: c_int
+ implicit none
+
+ integer::socket
+ integer, intent(in)::domain, stype, protocol
+
+ socket = socket_c(int(domain, c_int), int(stype, c_int), int(protocol, c_int))
+
+ end function socket
+
+ function inet_addr(str)
+ use iso_c_binding
+ implicit none
+
+ character(*), intent(in)::str
+ integer(c_int32_t)::inet_addr
+
+ character(kind=c_char), dimension(:), allocatable, target::cstr
+ integer::i
+
+ allocate(cstr(len_trim(str)+1))
+
+ do i=1, len_trim(str)
+ cstr(i) = str(i:i)
+ end do
+ cstr(len_trim(str)+1) = c_null_char
+
+ inet_addr = inet_addr_c(c_loc(cstr))
+
+ deallocate(cstr)
+
+ end function inet_addr
+
+ function connect(sockfd, sock_addr)
+ use iso_c_binding
+ implicit none
+
+ integer::sockfd
+ type(sockaddr_in), target::sock_addr
+ logical::connect
+
+ !print *, c_sizeof(sock_addr)
+
+ connect = (connect_c(int(sockfd, kind=c_int), &
+ c_loc(sock_addr), &
+ sockaddr_size) .eq. 0)
+
+ end function connect
+
+ function gethostbyname(host, success) result(res)
+ use iso_c_binding
+ implicit none
+
+ character(*)::host
+ type(simple_hostent)::res
+
+ type(hostent_c), pointer::cres
+ type(c_ptr)::callres
+
+ logical, intent(out), optional::success
+
+ ! To get the host to C
+ character(kind=c_char), dimension(:), allocatable, target::chost
+ integer::i
+
+ ! To process h_name
+ character(kind=c_char), dimension(:), pointer::h_name
+
+ ! To process h_addr
+ type(c_ptr), dimension(:), pointer::addrptr
+ integer(kind=c_int32_t), pointer::addr32
+ integer(kind=c_int64_t), pointer::addr64
+
+ allocate(chost(len_trim(host)+1))
+
+ do i=1, len_trim(host)
+ chost(i) = host(i:i)
+ end do
+ chost(len_trim(host)+1) = c_null_char
+
+ callres = gethostbyname_c(c_loc(chost))
+ if(c_associated(callres)) then
+ call c_f_pointer(callres, cres)
+
+ ! Extract the name
+ call c_f_pointer(cres%h_name, h_name, [1])
+ i = 1
+ do while(h_name(i) /= c_null_char)
+ i = i + 1
+ end do
+ allocate(character(len=i-1) :: res%h_name)
+ i = 1
+ do while(h_name(i) /= c_null_char)
+ res%h_name(i:i) = h_name(i)
+ i = i + 1
+ end do
+
+ ! And address
+ res%h_addr4 = 0
+ res%h_addr6 = 0
+
+ res%h_addrtype = cres%h_addrtype
+ call c_f_pointer(cres%h_addr_list, addrptr, [1])
+ if(res%h_addrtype == AF_INET) then
+ call c_f_pointer(addrptr(1), addr32)
+ res%h_addr4 = addr32
+ else if(res%h_addrtype == AF_INET6) then
+ call c_f_pointer(addrptr(1), addr64)
+ res%h_addr6 = addr64
+ end if
+
+ if(present(success)) then
+ success = .TRUE.
+ end if
+ else
+ if(present(success)) then
+ success = .FALSE.
+ end if
+ end if
+
+ end function gethostbyname
+
+end module network \ No newline at end of file