! Copyright (c) 2020 Jeffrey Armstrong <jeff@rainbow-100.com>
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! The Software shall be used for Good, not Evil.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
! SOFTWARE.

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 inet_ntoa_c(ip) bind(c, name="inet_ntoa")
        use iso_c_binding
        type(c_ptr)::inet_ntoa_c
        integer(c_int32_t), value::ip
        end function inet_ntoa_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
        
        function close_c(s) bind(c, name="close")
        use iso_c_binding
        integer(kind=c_int), value::s
        integer(kind=c_int)::close_c
        end function close_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
    
    subroutine close_socket(s)
    use iso_c_binding
    implicit none
    
        integer::s
        integer::ignored
        
        ignored = close_c(int(s, kind=c_int))
        
    end subroutine close_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 inet_ntoa(ip) result(res)
    use iso_c_binding
    implicit none
    
        integer(kind=c_int32_t), intent(in)::ip
        character(15)::res
        
        type(c_ptr)::cptr
        character(kind=c_char), dimension(:), pointer::cres
        integer::i
        
        res = " "
        cptr = inet_ntoa_c(ip)
        if(c_associated(cptr)) then
            call c_f_pointer(cptr, cres, [1])
        
            i = 1
            do while(cres(i) /= c_null_char)
                res(i:i) = cres(i)
                i = i + 1
            end do
        end if
    
    end function inet_ntoa
    
    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