aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJeffrey Armstrong <jeff@approximatrix.com>2020-05-01 11:21:05 -0400
committerJeffrey Armstrong <jeff@approximatrix.com>2020-05-01 11:21:05 -0400
commitc7a908cc5adede6ca34519059f2e324dc6737ff6 (patch)
tree98a32e703bac397e37c38d1fdbfa16123e2d46af
parent690395a50cd55401a9cfee598638bef482d164bd (diff)
downloadLR-87-c7a908cc5adede6ca34519059f2e324dc6737ff6.tar.gz
LR-87-c7a908cc5adede6ca34519059f2e324dc6737ff6.zip
SSL network connections now seem to work, including on windows
-rw-r--r--gemini-windows.prj5
-rw-r--r--jessl.f9020
-rw-r--r--network.F9048
-rw-r--r--request.f9081
-rw-r--r--test_ssl.f9060
5 files changed, 203 insertions, 11 deletions
diff --git a/gemini-windows.prj b/gemini-windows.prj
index 44c4108..87bd634 100644
--- a/gemini-windows.prj
+++ b/gemini-windows.prj
@@ -17,6 +17,9 @@
"filename":".\\network.F90",
"enabled":"1"
},{
+ "filename":".\\request.f90",
+ "enabled":"1"
+ },{
"filename":".\\test_ssl.f90",
"enabled":"1"
},{
@@ -45,7 +48,7 @@
"Name":"gemini-windows (target.exe)",
"Options":{
"Compiler Options":{
- "Fortran Flags":"",
+ "Fortran Flags":"-DWINDOWS",
"Link Flags":"-lssl -lcrypto -lws2_32 -lcrypt32",
"C Flags":""
},
diff --git a/jessl.f90 b/jessl.f90
index a27803e..34fb2a2 100644
--- a/jessl.f90
+++ b/jessl.f90
@@ -5,7 +5,7 @@ implicit none
interface
- subroutine library_init() bind(c, name="SSL_library_init")
+ subroutine library_init() bind(c, name="OPENSSL_init_ssl")
end subroutine library_init
subroutine add_ssl_algorithms() bind(c, name="SSLeay_add_ssl_algorithms")
@@ -46,7 +46,7 @@ implicit none
function ssl_connect(ssl) bind(c, name="SSL_connect")
use iso_c_binding
- integer(kind=c_int)::connect
+ integer(kind=c_int)::ssl_connect
type(c_ptr), value::ssl
end function ssl_connect
@@ -80,6 +80,12 @@ implicit none
integer(kind=c_int)::get_error
end function get_error
+ function ssl_pending(ssl) bind(c, name="SSL_pending")
+ use iso_c_binding
+ type(c_ptr), value::ssl
+ integer(kind=c_int)::ssl_pending
+ end function ssl_pending
+
end interface
contains
@@ -91,12 +97,13 @@ contains
type(c_ptr)::ssl
character, dimension(:), intent(inout)::buf
integer::ssl_read
+ integer::bufsize
character(kind=c_char), dimension(:), allocatable::cbuf
+ bufsize = size(buf)
+ allocate(cbuf(bufsize))
- allocate(cbuf(size(buf)))
-
- ssl_read = read_c(ssl, cbuf, size(buf))
+ ssl_read = read_c(ssl, cbuf, 1)
buf = cbuf
deallocate(cbuf)
@@ -116,8 +123,9 @@ contains
allocate(cbuf(size(buf)))
cbuf = buf
+ cbuf(size(buf)) = c_null_char
ssl_write = write_c(ssl, cbuf, size(buf))
-
+
deallocate(cbuf)
end function ssl_write
diff --git a/network.F90 b/network.F90
index 2130841..2ad520b 100644
--- a/network.F90
+++ b/network.F90
@@ -56,6 +56,12 @@ implicit none
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
@@ -77,6 +83,12 @@ implicit none
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
@@ -92,6 +104,17 @@ implicit none
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
@@ -115,6 +138,31 @@ implicit none
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
diff --git a/request.f90 b/request.f90
new file mode 100644
index 0000000..d470a06
--- /dev/null
+++ b/request.f90
@@ -0,0 +1,81 @@
+module request
+implicit none
+
+ integer, parameter::bufsize = 65536
+
+contains
+
+ function send_string(ssl, str, trimming) result(success)
+ use iso_c_binding
+ use jessl
+ implicit none
+
+ logical::success
+ type(c_ptr)::ssl
+ character(*), intent(in)::str
+ logical, intent(in), optional::trimming
+
+ integer::start_send
+ integer::chars_sent_this_time, chars_sending
+ integer::i, bytes
+ integer::string_length
+
+ character, dimension(bufsize)::buffer
+
+ if(present(trimming)) then
+ if(trimming) then
+ string_length = len_trim(str)
+ else
+ string_length = len(str)
+ end if
+ else
+ string_length = len_trim(str)
+ end if
+
+ success = .true.
+ start_send = 1
+ do while(start_send <= string_length)
+
+ chars_sending = 0
+ do i = start_send, string_length
+ buffer(i-start_send+1) = str(i:i)
+ chars_sending = chars_sending + 1
+ if(chars_sending == bufsize) then
+ exit
+ end if
+ end do
+
+ ! A null character seems necessary at the end of the request
+ if(i >= string_length) then
+ chars_sending = chars_sending + 1
+ buffer(chars_sending) = c_null_char
+ end if
+
+ ! Minus 1 because we're sending start_send as well
+ chars_sent_this_time = ssl_write(ssl, buffer(start_send:(start_send+chars_sending-1)))
+
+ if(chars_sent_this_time < 0) then
+ success = .false.
+ exit
+ end if
+
+ start_send = start_send + chars_sent_this_time
+
+ end do
+
+ end function send_string
+
+ function retrieve_characters(ssl, arr) result(chars_read)
+ use iso_c_binding
+ use jessl
+ implicit none
+
+ integer::chars_read
+ type(c_ptr)::ssl
+ character(len=1), dimension(:), intent(inout)::arr
+
+ chars_read = ssl_read(ssl, arr)
+
+ end function retrieve_characters
+
+end module request \ No newline at end of file
diff --git a/test_ssl.f90 b/test_ssl.f90
index 04386d4..9c22895 100644
--- a/test_ssl.f90
+++ b/test_ssl.f90
@@ -1,28 +1,44 @@
program test_ssl
+use iso_c_binding
use jessl
use network
+use request
use wsa_network, only: windows_network_startup => startup
implicit none
type(sockaddr_in), target::sa
integer::s
+ character(*), parameter:: request_attempt = &
+ "gemini://gemini.circumlinar.space/"//C_CARRIAGE_RETURN//C_NEW_LINE
+
+ !"GET / HTTP/1.1"//C_CARRIAGE_RETURN//C_NEW_LINE&
+ !//"Host: rainbow-100.com"//C_CARRIAGE_RETURN//C_NEW_LINE&
+ !//C_CARRIAGE_RETURN//C_NEW_LINE
+
type(simple_hostent)::hent
+ type(c_ptr)::ssl_method, ssl_ctx, ssl
+
+ character, dimension(bufsize)::buffer
+ integer::bytes_received, i
+
call windows_network_startup()
- hent = gethostbyname("google.com")
+ hent = gethostbyname("gemini.circumlunar.space")
+ !"rainbow-100.com")
+
if(allocated(hent%h_name)) then
Print *, "host: ", hent%h_name
- Print *, "addr: ", hent%h_addr4
+ Print *, "addr: ", inet_ntoa(hent%h_addr4)
else
Print *, "Failure"
stop
end if
sa%sin_family = AF_INET
- sa%sin_addr%s_addr = hent%h_addr4 !inet_addr("192.168.2.90")
- sa%sin_port = htons(80)
+ sa%sin_addr%s_addr = hent%h_addr4
+ sa%sin_port = htons(1965) !443)
s = socket(AF_INET, SOCK_STREAM, 0);
if(.not. connect(s, sa)) then
@@ -32,5 +48,41 @@ implicit none
Print *, "socket opened!"
+ call library_init()
+ ssl_method = tls_v1_3_client_method()
+ ssl_ctx = ctx_new(ssl_method)
+ ssl = ssl_new(ssl_ctx)
+
+ if(set_fd(ssl, s) == 1) then
+ Print *, "FD set"
+ if(ssl_connect(ssl) == 1) then
+ Print *, "Connected via SSL"
+
+
+ if(send_string(ssl, request_attempt, trimming=.false.)) then
+ Print *, "Message sent"
+
+ bytes_received = retrieve_characters(ssl, buffer)
+ do while(bytes_received > 0)
+ do i=1, bytes_received
+ write(*, '(A1)', advance='no') buffer(i)
+ end do
+ bytes_received = retrieve_characters(ssl, buffer)
+ end do
+
+ Print *, " "
+ Print *, "DONE"
+ else
+ Print *, "Could not send request"
+ end if
+
+ else
+ Print *, "Did not complete the ssl handshake..."
+ end if
+ else
+ Print *, "No fd set"
+ end if
+
+ call close_socket(s)
end program test_ssl \ No newline at end of file