套接字编程gfortran

sudo apt-get install gfortran

program socket_example
    use, intrinsic :: iso_c_binding
    implicit none
    integer(c_int) :: sockfd, newsockfd, portno, clilen
    integer(c_int) :: pid
    character(len=10) :: buffer
    integer(c_int) :: n
    integer(c_int) :: i
    integer(c_int) :: status
    integer(c_int) :: optval = 1
    type(c_ptr) :: addr
    type(c_ptr) :: newaddr
    integer(c_int) :: addrlen
    integer(c_int) :: listen_queue = 5

    sockfd = socket(AF_INET, SOCK_STREAM, 0)
    if (sockfd < 0) then
        write(*,*) 'ERROR opening socket'
        stop
    end if

    portno = 12345

    optval = 1
    status = setsockopt(sockfd, SOL_SOCKET, SO_REUSEADDR, c_loc(optval), c_sizeof(optval))
    if (status < 0) then
        write(*,*) 'ERROR on setsockopt'
        stop
    end if

    addr = c_malloc(c_sizeof(sockaddr_in))
    newaddr = c_malloc(c_sizeof(sockaddr_in))
    addrlen = c_sizeof(sockaddr_in)

    memset(addr, 0, c_sizeof(sockaddr_in))
    memset(newaddr, 0, c_sizeof(sockaddr_in))

    associate(sin => sockaddr_in_ptr(addr))
        sin%sin_family = AF_INET
        sin%sin_addr%s_addr = INADDR_ANY
        sin%sin_port = htons(portno)
    end associate

    status = bind(sockfd, addr, c_sizeof(sockaddr_in))
    if (status < 0) then
        write(*,*) 'ERROR on binding'
        stop
    end if

    status = listen(sockfd, listen_queue)
    if (status < 0) then
        write(*,*) 'ERROR on listen'
        stop
    end if

    write(*,*) 'Server listening on port', portno

    do while (.true.)
        newsockfd = accept(sockfd, newaddr, c_loc(addrlen))
        if (newsockfd < 0) then
            write(*,*) 'ERROR on accept'
            stop
        end if

        write(*,*) 'New client connected'

        pid = fork()
        if (pid < 0) then
            write(*,*) 'ERROR on fork'
            stop
        else if (pid == 0) then
            close(sockfd)
            do while (.true.)
                n = read(newsockfd, buffer, 9)
                if (n < 0) then
                    write(*,*) 'ERROR reading from socket'
                    stop
                end if

                buffer(n+1:10) = c_null_char
                write(*,*) 'Received:', trim(buffer)

                n = write(newsockfd, buffer, n)
                if (n < 0) then
                    write(*,*) 'ERROR writing to socket'
                    stop
                end if
            end do
        else
            close(newsockfd)
        end if
    end do

    deallocate(addr)
    deallocate(newaddr)
    close(sockfd)

end program socket_example