From 690395a50cd55401a9cfee598638bef482d164bd Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Thu, 30 Apr 2020 17:58:35 -0400 Subject: Fixed initialization of windows networking. Fixed some overruns in hostent processing. --- network.F90 | 207 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 207 insertions(+) create mode 100644 network.F90 (limited to 'network.F90') 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 -- cgit v1.2.3