aboutsummaryrefslogtreecommitdiff
path: root/network.f90
blob: a4a3ddc89eea5410844dbf04fb01c019476f2dbf (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
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