aboutsummaryrefslogtreecommitdiff
path: root/captain/gemini.f90
blob: ce7b984cd36e5e4b75c42cfe87659e1e286a5e39 (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
module gemini
implicit none

contains

    subroutine read_request(ssl, req)
    use jessl, only: ssl_read
    use iso_c_binding
    implicit none
    
        type(c_ptr)::ssl
        character(*), intent(out)::req
        
        character, dimension(64)::buf
        integer::bufread
        
        integer::i, j
        
        req = " "
        i = 1
        
        bufread = ssl_read(ssl, buf)
        do while(bufread > 0)
            
            do j = 1, bufread
                if(buf(j) == c_new_line) then
                    exit
                end if
                
                if(buf(j) /= c_carriage_return) then
                    req(i:i) = buf(j)
                    i = i + 1
                end if
                
            end do
            
            if(buf(j) == c_new_line) then
                exit
            end if
            
            bufread = ssl_read(ssl, buf)
        end do
    
    end subroutine read_request

    subroutine handle_request()
    use jessl
    use iso_c_binding
    use config
    use iso_fortran_env
    implicit none
    
        ! For our TLS connection
        type(c_ptr)::ctx
        type(c_ptr)::method
        type(c_ptr)::ssl
        integer(kind=c_long)::res
        
        ! Requested file
        character(1024)::request
        character(512)::mimetype
                
        call library_init()

        method = tls_server_method()
        ctx = ctx_new(method)

        if(.not. C_ASSOCIATED(ctx)) then
            call write_log("Context failed")
            return
        end if

        ! Seems to be a dummy now...
        !res = ctx_set_ecdh_auto(ctx, 1)

        if(.not. ctx_use_certificate_file(ctx, trim(pubcert), SSL_FILETYPE_PEM)) then
            call write_log("Cert file failed")
            call write_log("Public: "//trim(pubcert))
            !call print_error()
            return
        end if

        if(.not. ctx_use_private_key_file(ctx, trim(privcert), SSL_FILETYPE_PEM)) then
            call write_log("Cert file failed")
            call write_log("Private: "//trim(privcert))
            !call print_error()
            return
        end if

        ssl = ssl_new(ctx)

        call write_log("Initiating connection")

        ! So this is a GNU Extension...
        res = set_read_fd(ssl, fnum(input_unit))
        if(res /= 1) then
            call write_log("set rfd failed")
            !call print_error()
            return
        end if

        res = set_write_fd(ssl, fnum(output_unit))
        if(res /= 1) then
            call write_log("set wfd failed")
            !call print_error()
            return
        end if

        res = ssl_accept(ssl)
        if(res <= 0) then
            call write_log("ssl_accept failed")
            !call print_error()
            return
        end if

        call write_log("Handling read_request")

        ! Do the actual protocol nonsense
        call read_request(ssl, request)

        call write_log("Request is "//trim(request))

        ! If it ends in a slash, let's manually and silently add "index.gmi"
        if(request(len_trim(request):len_trim(request)) == "/") then
            request = trim(request)//"index.gmi"
        end if
    
    
    end subroutine handle_request

end module gemini