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. --- gemini-windows.prj | 98 +++++++++++++++++++++++++ network.F90 | 207 +++++++++++++++++++++++++++++++++++++++++++++++++++++ network.f90 | 201 --------------------------------------------------- test_ssl.f90 | 7 +- wsa.f90 | 46 ++++++++++++ 5 files changed, 356 insertions(+), 203 deletions(-) create mode 100644 gemini-windows.prj create mode 100644 network.F90 delete mode 100644 network.f90 create mode 100644 wsa.f90 diff --git a/gemini-windows.prj b/gemini-windows.prj new file mode 100644 index 0000000..44c4108 --- /dev/null +++ b/gemini-windows.prj @@ -0,0 +1,98 @@ +{ + "Root":{ + "Folders":[{ + "Folders":[], + "Name":"+samples", + "Files":[{ + "filename":".\\samples\\sample1.gmi", + "enabled":"1" + }] + },{ + "Folders":[], + "Name":"+ssl", + "Files":[{ + "filename":".\\jessl.f90", + "enabled":"1" + },{ + "filename":".\\network.F90", + "enabled":"1" + },{ + "filename":".\\test_ssl.f90", + "enabled":"1" + },{ + "filename":".\\wsa.f90", + "enabled":"1" + }] + }], + "Name":"+gemini-windows (target.exe)", + "Files":[{ + "filename":".\\dumb_render.f90", + "enabled":"1" + },{ + "filename":".\\files.f90", + "enabled":"1" + },{ + "filename":".\\layout.f90", + "enabled":"1" + },{ + "filename":".\\render.f90", + "enabled":"1" + },{ + "filename":".\\test.f90", + "enabled":"0" + }] + }, + "Name":"gemini-windows (target.exe)", + "Options":{ + "Compiler Options":{ + "Fortran Flags":"", + "Link Flags":"-lssl -lcrypto -lws2_32 -lcrypt32", + "C Flags":"" + }, + "Architecture":1, + "Type":0, + "Revision":2, + "Windows GUI":0, + "File Options":{ + "Library Directories":["Default Add-On Directory","../../Workspace/git/libvncserver/openssl-1.1.1f-win64-mingw/lib"], + "Build Directory":"build", + "Module Directory":"modules", + "Include Directories":["Default Add-On Include Directory"] + }, + "Target":"target.exe", + "Fortran Options":{ + "Use C Preprocessor":"false", + "Runtime Diagnostics":"false", + "Cray Pointers":"false", + "Enable OpenMP":"false", + "Enable Coarrays":"false", + "Default Double for Real":"false" + }, + "Code Generation Options":{ + "CPU Specific":"false", + "Processor":"generic", + "Aggressive Loops":"false", + "Debugging":"true", + "Optimization Mode":0, + "Profiling":"false" + }, + "Build Dependencies":1, + "Launch Options":{ + "Working Directory":"", + "Launch Using MPI":"false", + "Keep Console":"true", + "External Console":"false", + "Command Line Arguments":"-g samples\\sample1.gmi", + "Build Before Launch":"true" + }, + "Build Options":{ + "Makefile":"Makefile", + "Auto Makefile":"true" + }, + "Linker Options":{ + "Static Linking Mode":0, + "Link MPI Library":"false", + "Link LAPACK":0 + } + } +} \ No newline at end of file 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 diff --git a/network.f90 b/network.f90 deleted file mode 100644 index a4a3ddc..0000000 --- a/network.f90 +++ /dev/null @@ -1,201 +0,0 @@ -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 - - 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=c_int):: h_addrtype !host address type */ - integer(kind=c_int):: 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) :: 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 diff --git a/test_ssl.f90 b/test_ssl.f90 index 0e169c1..04386d4 100644 --- a/test_ssl.f90 +++ b/test_ssl.f90 @@ -1,6 +1,7 @@ program test_ssl use jessl use network +use wsa_network, only: windows_network_startup => startup implicit none type(sockaddr_in), target::sa @@ -8,10 +9,12 @@ implicit none type(simple_hostent)::hent + call windows_network_startup() + hent = gethostbyname("google.com") if(allocated(hent%h_name)) then - !Print *, "host: ", hent%h_name - !Print *, "addr: ", hent%h_addr4 + Print *, "host: ", hent%h_name + Print *, "addr: ", hent%h_addr4 else Print *, "Failure" stop diff --git a/wsa.f90 b/wsa.f90 new file mode 100644 index 0000000..c46b097 --- /dev/null +++ b/wsa.f90 @@ -0,0 +1,46 @@ +module wsa_network +use iso_c_binding +implicit none + + integer, parameter::wsa_description_length_plus_1 = 256 + + type, bind(c) :: wsadata + integer(kind=c_int16_t)::wVersion + integer(kind=c_int16_t)::wHighVersion + integer(kind=c_short)::iMaxSockets + integer(kind=c_short)::iMaxUdpDg + + type(c_ptr)::lpVendorInfo + character(len=1, kind=c_char), dimension(wsa_description_length_plus_1)::szDescription + character(len=1, kind=c_char), dimension(wsa_description_length_plus_1)::szSystemStatus + end type + +contains + + subroutine startup() + use iso_c_binding + implicit none + + interface + function wsa_startup(v, p) bind(c, name="WSAStartup") + use iso_c_binding + integer(kind=c_int16_t), value::v + type(c_ptr), value::p + integer(kind=c_int)::wsa_startup + end function wsa_startup + end interface + + type(wsadata), target::startup_data + integer::res + + ! need to use wVersionRequested = MAKEWORD(2, 2); + + + res = wsa_startup(int(z'0202', kind=c_int16_t), c_loc(startup_data)) + if(res /= 0) then + Print *, "Windows Networking failed to start" + Print *, "Error=", res + stop + end if + end subroutine startup +end module wsa_network -- cgit v1.2.3