Initial import

11 files changed, 2349 insertions, 0 deletions

diff --git a/common/jessl.f90 b/common/jessl.f90
new file mode 100644
index 0000000..223fd14
--- /dev/null
+++ b/common/jessl.f90
@@ -0,0 +1,374 @@
+! 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.
+
+! Just Enough SSL...
+
+module jessl
+use iso_c_binding
+implicit none
+
+    ! Constants needed for SNI
+    integer(kind=c_long), parameter::TLSEXT_NAMETYPE_host_name = 0
+    
+    integer(kind=c_int), parameter::SSL_CTRL_SET_TLSEXT_HOSTNAME = 55
+    
+    integer(kind=c_int), parameter::SSL_FILETYPE_PEM = 1
+    
+    interface 
+    
+        function init_ssl_c(flags, settings) bind(c, name="OPENSSL_init_ssl")
+        use iso_c_binding
+        integer(kind=c_int64_t), value::flags
+        type(c_ptr), value::settings
+        integer(kind=c_int)::init_ssl_c
+        end function init_ssl_c
+
+        subroutine add_ssl_algorithms() bind(c, name="SSLeay_add_ssl_algorithms")
+        end subroutine add_ssl_algorithms
+        
+        subroutine load_error_strings() bind(c, name="SSL_load_error_strings")
+        end subroutine load_error_strings
+        
+        function tls_client_method() bind(c, name="TLS_client_method")
+        use iso_c_binding
+        type(c_ptr)::tls_client_method
+        end function tls_client_method
+
+        function tls_server_method() bind(c, name="TLS_server_method")
+        use iso_c_binding
+        type(c_ptr)::tls_server_method
+        end function tls_server_method
+
+        !subroutine print_error() bind(c, name="print_error")
+        !use iso_c_binding
+        !end subroutine print_error
+
+        function ctx_new(meth) bind(c, name="SSL_CTX_new")
+        use iso_c_binding
+        type(c_ptr)::ctx_new
+        type(c_ptr), value::meth
+        end function ctx_new
+        
+        function ctx_set_ecdh_auto(ctx, state) bind(c, name="SSL_CTX_set_ecdh_auto")
+        use iso_c_binding
+        type(c_ptr), value::ctx
+        integer(kind=c_int), value::state
+        integer(kind=c_long)::ctx_set_ecdh_auto
+        end function ctx_set_ecdh_auto
+        
+        function ctx_use_certificate_file_c(ctx, filename, certtype) bind(c, name="SSL_CTX_use_certificate_file")
+        use iso_c_binding
+        type(c_ptr), value::ctx
+        character(kind=c_char), dimension(*), intent(inout)::filename
+        integer(kind=c_int), value::certtype
+        integer(kind=c_int)::ctx_use_certificate_file_c
+        end function ctx_use_certificate_file_c
+        
+        function ctx_use_private_key_file_c(ctx, filename, certtype) bind(c, name="SSL_CTX_use_PrivateKey_file")
+        use iso_c_binding
+        type(c_ptr), value::ctx
+        character(kind=c_char), dimension(*), intent(inout)::filename
+        integer(kind=c_int), value::certtype
+        integer(kind=c_int)::ctx_use_private_key_file_c
+        end function ctx_use_private_key_file_c
+        
+        function ssl_new(ctx) bind(c, name="SSL_new")
+        use iso_c_binding
+        type(c_ptr)::ssl_new
+        type(c_ptr), value::ctx
+        end function ssl_new
+        
+        function get_fd(ssl) bind(c, name="SSL_get_fd")
+        use iso_c_binding
+        integer(kind=c_int)::get_fd
+        type(c_ptr), value::ssl
+        end function get_fd
+        
+        function set_fd(ssl, fd) bind(c, name="SSL_set_fd")
+        use iso_c_binding
+        integer(kind=c_int)::set_fd
+        integer(kind=c_int), value::fd
+        type(c_ptr), value::ssl
+        end function set_fd
+        
+        function set_read_fd(ssl, fd) bind(c, name="SSL_set_rfd")
+        use iso_c_binding
+        integer(kind=c_int)::set_read_fd
+        integer(kind=c_int), value::fd
+        type(c_ptr), value::ssl
+        end function set_read_fd
+        
+        function set_write_fd(ssl, fd) bind(c, name="SSL_set_wfd")
+        use iso_c_binding
+        integer(kind=c_int)::set_write_fd
+        integer(kind=c_int), value::fd
+        type(c_ptr), value::ssl
+        end function set_write_fd
+        
+        function ssl_connect(ssl) bind(c, name="SSL_connect")
+        use iso_c_binding
+        integer(kind=c_int)::ssl_connect
+        type(c_ptr), value::ssl
+        end function ssl_connect
+        
+        function ssl_accept(ssl) bind(c, name="SSL_accept")
+        use iso_c_binding
+        integer(kind=c_int)::ssl_accept
+        type(c_ptr), value::ssl
+        end function ssl_accept
+        
+        function ssl_shutdown(ssl) bind(c, name="SSL_shutdown")
+        use iso_c_binding
+        integer(kind=c_int)::ssl_shutdown
+        type(c_ptr), value::ssl
+        end function ssl_shutdown
+        
+        function ssl_free(ssl) bind(c, name="SSL_free")
+        use iso_c_binding
+        integer(kind=c_int)::ssl_free
+        type(c_ptr), value::ssl
+        end function ssl_free
+        
+        function ctx_free(ctx) bind(c, name="SSL_CTX_free")
+        use iso_c_binding
+        integer(kind=c_int)::ctx_free
+        type(c_ptr), value::ctx
+        end function ctx_free
+        
+        function ssl_ctrl_c(ctx, cmd, arg, vp) bind(c, name="SSL_ctrl")
+        use iso_c_binding
+        type(c_ptr), value::ctx
+        integer(kind=c_int), value::cmd
+        integer(kind=c_long), value::arg
+        type(c_ptr), value::vp
+        integer(kind=c_long)::ssl_ctrl_c
+        end function ssl_ctrl_c
+        
+        ! Actually a macro...
+        !function get_cipher_c(ssl) bind(c, name="SSL_get_cipher_name")
+        !use iso_c_binding
+        !type(c_ptr)::get_cipher_c
+        !type(c_ptr), value::ssl
+        !end function get_cipher_c
+        
+        function read_c(ssl, buf, length) bind(c, name="SSL_read")
+        use iso_c_binding
+        type(c_ptr), value::ssl
+        character(kind=c_char), dimension(*), intent(inout)::buf
+        integer(kind=c_int), value::length
+        integer(kind=c_int)::read_c
+        end function read_c
+        
+        function write_c(ssl, buf, length) bind(c, name="SSL_write")
+        use iso_c_binding
+        type(c_ptr), value::ssl
+        character(kind=c_char), dimension(*), intent(inout)::buf
+        integer(kind=c_int), value::length
+        integer(kind=c_int)::write_c
+        end function write_c
+        
+        function get_error(ssl, retcode) bind(c, name="SSL_get_error")
+        use iso_c_binding
+        type(c_ptr), value::ssl
+        integer(kind=c_int), value::retcode
+        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
+
+    function ssl_read(ssl, buf)
+    use iso_c_binding
+    implicit none
+    
+        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))
+        
+        ssl_read = read_c(ssl, cbuf, bufsize)
+        buf = cbuf
+        
+        deallocate(cbuf)
+        
+    end function ssl_read
+    
+    function ssl_write(ssl, buf)
+    use iso_c_binding
+    implicit none
+    
+        type(c_ptr)::ssl
+        character, dimension(:), intent(in)::buf
+        integer::ssl_write
+        
+        character(kind=c_char), dimension(:), allocatable::cbuf
+        
+        allocate(cbuf(size(buf)))
+        
+        cbuf = buf
+        ssl_write = write_c(ssl, cbuf, size(buf))
+
+        deallocate(cbuf)
+    
+    end function ssl_write
+    
+    subroutine get_cipher(ssl, res)
+    use iso_c_binding
+    implicit none
+    
+        character(:), allocatable, intent(out)::res
+        type(c_ptr)::ssl
+        
+        type(c_ptr)::cptr
+        
+        character(kind=c_char), dimension(:), pointer::cstring
+        
+        integer::i
+        
+        cptr = c_null_ptr
+        if(.not. c_associated(cptr)) then
+        
+            allocate(character(len=1)::res)
+            res = " "
+        
+        else
+        
+            call c_f_pointer(cptr, cstring, [1])
+        
+            i = 1
+            do while(cstring(i) /= c_null_char)
+                i = i + 1
+            end do
+            allocate(character(len=(i-1))::res)
+            
+            i = 1
+            do while(cstring(i) /= c_null_char)
+                res(i:i) = cstring(i)
+            end do
+            
+        end if
+        
+    end subroutine get_cipher
+    
+    function set_tlsext_host_name(ctx, hostname)
+    use iso_c_binding
+    implicit none
+    
+        type(c_ptr)::ctx
+        character(*), intent(in)::hostname
+        integer::set_tlsext_host_name
+        
+        character(kind=c_char), dimension(:), allocatable, target::chostname
+        
+        integer::i
+        
+        allocate(chostname(len_trim(hostname)+1))
+        
+        do i = 1, len_trim(hostname)
+            chostname(i) = hostname(i:i)
+        end do
+        chostname(len_trim(hostname)+1) = c_null_char
+
+        set_tlsext_host_name = ssl_ctrl_c(ctx, &
+                                          SSL_CTRL_SET_TLSEXT_HOSTNAME, &
+                                          TLSEXT_NAMETYPE_host_name, &
+                                          c_loc(chostname))
+        
+        deallocate(chostname)
+    
+    end function set_tlsext_host_name
+    
+    function ctx_use_certificate_file(ctx, filename, certtype)
+    use iso_c_binding
+    implicit none
+    
+        type(c_ptr)::ctx
+        character(*), intent(in)::filename
+        integer::certtype
+        logical::ctx_use_certificate_file
+        
+        character(kind=c_char), dimension(:), allocatable, target::cfilename
+        
+        integer::i
+        
+        allocate(cfilename(len_trim(filename)+1))
+        do i = 1, len_trim(filename)
+            cfilename(i) = filename(i:i)
+        end do
+        cfilename(len_trim(filename)+1) = c_null_char
+        i = ctx_use_certificate_file_c(ctx, cfilename, int(certtype, kind=c_int))
+        ctx_use_certificate_file = (i == 1)
+        
+        deallocate(cfilename)
+        
+    end function ctx_use_certificate_file
+    
+    function ctx_use_private_key_file(ctx, filename, certtype)
+    use iso_c_binding
+    implicit none
+    
+        type(c_ptr)::ctx
+        character(*), intent(in)::filename
+        integer::certtype
+        logical::ctx_use_private_key_file
+        
+        character(kind=c_char), dimension(:), allocatable, target::cfilename
+        
+        integer::i
+        
+        allocate(cfilename(len_trim(filename)+1))
+        do i = 1, len_trim(filename)
+            cfilename(i) = filename(i:i)
+        end do
+        cfilename(len_trim(filename)+1) = c_null_char
+        
+        i = ctx_use_private_key_file_c(ctx, cfilename, int(certtype, kind=c_int))
+        ctx_use_private_key_file = (i == 1)
+        
+        deallocate(cfilename)
+        
+    end function ctx_use_private_key_file
+    
+    subroutine library_init()
+    use iso_c_binding
+    implicit none
+    
+        integer(kind=c_int64_t)::flags
+        integer::res
+    
+        flags = 0
+        res = init_ssl_c(flags, c_null_ptr)
+    
+    end subroutine library_init
+
+end module jessl
diff --git a/common/network.F90 b/common/network.F90
new file mode 100644
index 0000000..90bf2be
--- /dev/null
+++ b/common/network.F90
@@ -0,0 +1,326 @@
+! 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
+    
+    integer, parameter::socket_timeout_ms = 10000
+    
+#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 
+    
+#ifndef WINDOWS
+    type, bind(c) :: timeval
+        integer(kind=c_long)::seconds
+        integer(kind=c_long)::useconds
+    end type
+#endif
+    
+    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
+        integer::ignored
+        
+#ifdef WINDOWS
+        integer(kind=c_int32_t), target::timeout
+        integer(kind=c_int), parameter::timeout_size=c_int32_t
+#else
+        type(timeval), target::timeout
+        integer(kind=c_int), parameter::timeout_size=2*c_long
+#endif
+        
+
+        ! Set up a timeout on the socket that's sensible
+        interface
+            function setsockopt(s, level, optname, optval, optlen) bind(c, name="setsockopt")
+            use iso_c_binding
+            integer(kind=c_int)::setsockopt
+            integer(kind=c_int), value::s
+            integer(kind=c_int), value::level, optname, optlen
+            type(c_ptr), value::optval
+            end function
+        end interface
+
+#ifdef WINDOWS
+        integer, parameter::SOL_SOCKET  = 65535
+        integer, parameter::SO_RCVTIMEO = 4102
+        timeout = socket_timeout_ms
+#else
+        integer, parameter::SOL_SOCKET  = 1
+        integer, parameter::SO_RCVTIMEO = 20
+        timeout%useconds = 0
+        timeout%seconds = socket_timeout_ms/1000
+#endif        
+
+        socket = socket_c(int(domain, c_int), int(stype, c_int), int(protocol, c_int))
+
+        ! Timeout call
+        ignored = setsockopt(socket, SOL_SOCKET, SO_RCVTIMEO, c_loc(timeout), timeout_size) 
+        
+        
+    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
+        integer::hnamelen
+        interface
+            function strlen_c(cstr) bind(c, name="strlen")
+            use iso_c_binding
+            type(c_ptr), value::cstr
+            integer(kind=c_size_t)::strlen_c
+            end function strlen_c
+        end interface
+        
+        
+        ! 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
+            hnamelen = strlen_c(cres%h_name)
+            call c_f_pointer(cres%h_name, h_name, [hnamelen])
+            allocate(character(len=i) :: res%h_name)
+            do i = 1, hnamelen
+                res%h_name(i:i) = h_name(i)
+            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
\ No newline at end of file
diff --git a/common/protocol.f90 b/common/protocol.f90
new file mode 100644
index 0000000..be6f280
--- /dev/null
+++ b/common/protocol.f90
@@ -0,0 +1,474 @@
+! 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 gemini_protocol
+implicit none
+
+    integer, parameter::STATUS_INPUT        = 1
+    integer, parameter::STATUS_SUCCESS      = 2
+    integer, parameter::STATUS_REDIRECT     = 3
+    integer, parameter::STATUS_TEMPFAIL     = 4
+    integer, parameter::STATUS_PERMFAIL     = 5
+    integer, parameter::STATUS_CERTREQ      = 6
+    integer, parameter::STATUS_BADRESPONSE  = 7
+    integer, parameter::STATUS_LOCALFAIL    = -1
+    integer, parameter::STATUS_CONNECTFAIL  = -2
+    integer, parameter::STATUS_PROTOCOLFAIL = -3
+
+    integer, parameter::BUFFER_SIZE = 256
+    
+    integer, parameter::gemini_default_port = 1965
+
+contains
+    
+    function is_failure_code(return_code)
+    implicit none
+    
+        integer, intent(in)::return_code
+        logical::is_failure_code
+        
+        is_failure_code = any(return_code == &
+            [STATUS_CONNECTFAIL, &
+             STATUS_LOCALFAIL, &
+             STATUS_BADRESPONSE, &
+             STATUS_PERMFAIL, &
+             STATUS_TEMPFAIL, &
+             STATUS_PROTOCOLFAIL])
+
+    end function is_failure_code
+    
+    subroutine get_mimetype(status_line, return_type)
+    implicit none
+    
+        character(*), intent(in)::status_line
+        character(*), intent(out)::return_type
+        
+        integer::i, j
+        
+        return_type = " "
+        
+        ! Advance past status and space
+        i = 1
+        do while(status_line(i:i) /= " " .and. status_line(i:i) /= char(9) .and. i < len_trim(status_line))
+            i = i + 1
+        end do
+        do while((status_line(i:i) == " " .or. status_line(i:i) == char(9)) .and. i < len_trim(status_line))
+            i = i + 1
+        end do
+        
+        j = 0
+        do while(.not. any([char(13), char(10)] == status_line(i:i)))
+            j = j + 1
+            return_type(j:j) = status_line(i:i)
+            i = i + 1
+        end do
+        
+        ! Default
+        if(len_trim(return_type) == 0) then
+            return_type = "text/gemini"
+        end if
+    
+    end subroutine get_mimetype
+    
+    function get_return_code(status_line) result(ret)
+    implicit none
+    
+        integer::ret
+        character(*), intent(in)::status_line
+        integer::istatus
+        
+        read(status_line, '(i1)', iostat=istatus) ret
+        
+        if(istatus /= 0) then 
+            ret = STATUS_BADRESPONSE
+        end if
+        
+    end function get_return_code
+
+    function request_url(url, unit_number, return_type) result(returncode)
+    use request
+    use iso_c_binding
+    implicit none
+    
+        character(*), intent(inout)::url
+        integer, intent(in)::unit_number
+        character(*), intent(out)::return_type
+        integer::port
+        
+        integer::returncode
+        
+        character(:), allocatable::server
+        
+        type(connection)::conn
+        
+        integer::bytes_received, i
+        character, dimension(BUFFER_SIZE)::buffer
+        
+        ! For direct processing of the reponse line
+        integer::response_line_index
+        character(1024)::response_line
+        logical::response_line_completed
+        
+        returncode = -1
+        rewind(unit_number)
+        
+
+        allocate(character(len=len_trim(url)) :: server)
+        call get_server_from_url(url, server, port)
+        if(port < 0) then
+            port = gemini_default_port
+        end if
+    
+        ! Correct URL relative paths
+        call fix_url_relative_paths(url)
+    
+        conn = open_connection(server)
+        
+        if(conn%code == CONNECTION_OPEN) then
+            if(send_string(conn%ssl, trim(url)//c_carriage_return//c_new_line, trimming=.false.)) then
+                
+                response_line_completed = .false.
+                response_line = " "
+                response_line_index = 0
+                
+                bytes_received = retrieve_characters(conn%ssl, buffer)
+                do while(bytes_received > 0)
+                
+                    do i=1, bytes_received
+                        
+                        if(.not. response_line_completed) then
+                            response_line_index = response_line_index + 1
+                            response_line(response_line_index:response_line_index) = buffer(i)
+                            
+                            ! If we encountered our first newline, we have a complete status
+                            ! line - handle it here
+                            if(buffer(i) == char(10) .or. response_line_index == 1024) then
+                                response_line_completed = .true.
+                                
+                                returncode = get_return_code(response_line)
+                                
+                                if(returncode == STATUS_SUCCESS) then
+                                
+                                    call get_mimetype(response_line, return_type)
+
+                                else
+                                
+                                    exit
+
+                                end if
+                                
+                            end if
+                            
+                        else
+                        
+                            write(unit_number) buffer(i)
+
+                        end if
+
+                    end do
+
+                    bytes_received = retrieve_characters(conn%ssl, buffer)
+                end do
+                
+            else
+            
+                returncode = STATUS_CONNECTFAIL
+                
+            end if
+            
+        else
+        
+            returncode = STATUS_CONNECTFAIL
+            
+        end if
+        
+        call close_connection(conn)
+    
+    end function request_url
+
+    function titan_post_url(url, unit_number, file_length, token, is_plain_text) result(returncode)
+    use request
+    use iso_c_binding
+    use utilities, only: read_into_buffer
+    use jessl, only: ssl_write
+    implicit none
+    
+        character(*), intent(inout)::url
+        character(*), intent(in)::token
+        integer, intent(in)::unit_number
+        logical, intent(in), optional::is_plain_text
+        integer::port
+        
+        integer::returncode
+
+        integer(kind=8), intent(in)::file_length
+        
+        character(:), allocatable::server
+        character(len=16)::file_length_text
+        
+        type(connection)::conn
+        
+        character, dimension(BUFFER_SIZE)::buffer
+        logical, dimension(4)::successes
+        integer::i, ierr, bytes_read, bytes_written, total_written
+        
+        returncode = -1
+        rewind(unit_number)
+        
+        allocate(character(len=len_trim(url)) :: server)
+        call get_server_from_url(url, server, port)
+        if(port < 0) then
+            port = gemini_default_port
+        end if
+    
+        ! Correct URL relative paths
+        call fix_url_relative_paths(url)
+    
+        conn = open_connection(server)
+        
+        if(conn%code == CONNECTION_OPEN) then
+        
+            successes(1) = send_string(conn%ssl, trim(url), trimming=.false.)
+            successes(2) = send_string(conn%ssl, ";token="//trim(token), trimming=.false.)
+            
+            if(present(is_plain_text)) then
+                if(is_plain_text) then
+                    successes(3) = send_string(conn%ssl, ";mime=text/plain", trimming=.false.)
+                else
+                    successes(3) = send_string(conn%ssl, ";mime=application/octet-stream", trimming=.false.)
+                end if
+            else
+                successes(3) = send_string(conn%ssl, ";mime=application/octet-stream", trimming=.false.)
+            end if
+            
+            write(file_length_text, *) file_length
+            file_length_text = adjustl(file_length_text)
+            successes(4) = send_string(conn%ssl, ";size="//trim(file_length_text)//c_carriage_return//c_new_line, trimming=.false.)
+        
+            if(all(successes, 1)) then
+                
+                total_written = 0
+                bytes_read = read_into_buffer(unit_number, buffer)
+                do while(bytes_read > 0)
+                    bytes_written = ssl_write(conn%ssl, buffer)
+                    total_written = total_written + bytes_written
+                    bytes_read = read_into_buffer(unit_number, buffer)
+                end do
+                
+                if(total_written >= file_length) then
+                    returncode = STATUS_SUCCESS
+                else
+                    returncode = STATUS_LOCALFAIL
+                end if
+                
+            else
+            
+                returncode = STATUS_CONNECTFAIL
+                
+            end if
+            
+        else
+        
+            returncode = STATUS_CONNECTFAIL
+            
+        end if
+        
+        call close_connection(conn)
+
+    end function titan_post_url
+
+    subroutine get_redirect_url(unit_number, url)
+    implicit none
+    
+        integer, intent(in)::unit_number
+        character(*), intent(inout)::url
+        
+        character(1024)::new_url
+        character::search
+        integer::i, istat
+        
+        rewind(unit_number)
+        
+        ! Status code
+        read(unit_number, '(A1)', advance='no') search
+        read(unit_number, '(A1)', advance='no') search
+        
+        new_url = " "
+        
+        ! At least one whitespace, but whatever...
+        read(unit_number, '(A1)', advance='no') search
+        do while(search == " " .or. search == CHAR(9))
+            read(unit_number, '(A1)', advance='no', iostat=istat) search
+        end do
+        
+        ! Now search contains our first url component
+        i = 0
+        do while(search /= CHAR(13) .and. i < len(url) .and. istat == 0)
+            i = i + 1
+            new_url(i:i) = search
+            read(unit_number, '(A1)', advance='no', iostat=istat) search
+        end do
+
+        ! Process this url properly
+        if(index(new_url, "://") > 0) then
+            url = new_url
+        else
+            call handle_relative_url(url, new_url)
+        end if
+        
+    end subroutine get_redirect_url
+
+    subroutine handle_relative_url(current_url, path)
+    implicit none
+    
+        character(*), intent(inout)::current_url
+        character(*), intent(in)::path
+        
+        integer::past_protocol, first_slash, last_slash
+        
+        ! For debugging
+        ! Print *, "*** Requested path is '"//trim(path)//"'"
+        
+        past_protocol = index(current_url, "://")
+        
+        if(path(1:2) == "//") then
+            current_url = "gemini:"//path
+            
+        else if(past_protocol > 0) then
+            
+            past_protocol = past_protocol + 3
+            
+            if(path(1:1) == "/") then
+            
+                first_slash = index(current_url(past_protocol:len_trim(current_url)), "/")
+                if(first_slash < 1) then
+                    current_url = trim(current_url)//trim(path)
+                else
+                    current_url = current_url(1:(past_protocol + first_slash - 1))//path(2:len_trim(path))
+                end if
+                
+            else
+            
+                last_slash = index(current_url, "/", back=.true.)
+                if(last_slash > 0) then
+                    current_url = current_url(1:last_slash)//path
+                end if
+                
+            end if
+            
+        end if 
+
+    end subroutine handle_relative_url
+    
+    subroutine replace_text(string, pattern, replacement, once)
+    implicit none
+    
+        character(*), intent(inout)::string
+        character(*), intent(in)::pattern
+        character(*), intent(in), optional::replacement
+        logical, intent(in), optional::once
+        
+        integer::i,j
+        
+        ! Print *, "*** Replacement: string='"//trim(string)//"' Pattern='"//pattern//"'"
+        
+        i = index(string, pattern)
+        do while(i > 0) 
+            j = i + len(pattern) ! First character after match
+            
+            ! First
+            if(i == 1) then
+                if(present(replacement)) then
+                    string = replacement//string(j:len_trim(string))
+                else
+                    string = string(j:len_trim(string))
+                end if
+                
+            ! Last
+            elseif(j > len_trim(string)) then
+                if(present(replacement)) then
+                    string = string(1:i-1)//replacement
+                else
+                    string = string(1:i-1)
+                end if
+        
+            ! Middle
+            else
+                if(present(replacement)) then
+                    string = string(1:i-1)//replacement//string(j:len_trim(string))
+                else
+                    string = string(1:i-1)//string(j:len_trim(string))
+                end if
+            end if
+            
+            ! All on the same line crashes GNU Fortran...
+            if(present(once)) then
+                if(once) then
+                    exit
+                end if
+            end if
+            
+            i = index(string, pattern)
+        end do
+    
+    end subroutine replace_text
+
+    subroutine fix_url_relative_paths(url)
+    implicit none
+    
+        character(*), intent(inout)::url
+        integer::i, pattern_start
+        
+        ! These shouldn't be there
+        i = index(url, '/./')
+        if(i > 0) then
+            call replace_text(url, '/./', replacement="/")
+        end if
+            
+        ! Remove ..
+        i = index(url, '/../')
+        do while(i > 0)
+        
+            ! Need to build the pattern
+            pattern_start = i - 1
+            do while(url(pattern_start:pattern_start) /= "/" .and. pattern_start > 1)
+                pattern_start = pattern_start - 1
+            end do
+            
+            if(pattern_start == 1) then
+                ! Error state - just exit
+                exit
+            end if
+            
+            ! Check for root...
+            if(url(pattern_start-1:pattern_start) == "//") then
+                call replace_text(url, "/../", replacement="/", once=.true.)
+            else
+                call replace_text(url, url(pattern_start:i+2), once=.true.)
+            end if
+            
+            i = index(url, '/../')
+        end do
+        
+    end subroutine fix_url_relative_paths
+
+end module gemini_protocol
\ No newline at end of file
diff --git a/common/request.f90 b/common/request.f90
new file mode 100644
index 0000000..e9043c0
--- /dev/null
+++ b/common/request.f90
@@ -0,0 +1,294 @@
+! 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 request
+use network
+use iso_c_binding
+implicit none
+
+    integer, parameter::bufsize = 65536
+    
+    integer, parameter::CONNECTION_NONE              = 0
+    integer, parameter::CONNECTION_CLOSED            = 1
+    integer, parameter::CONNECTION_SERVER_NOT_FOUND  = 2
+    integer, parameter::CONNECTION_SOCKET_FAILURE    = 3
+    integer, parameter::CONNECTION_SSL_SETUP_FAILURE = 4
+    integer, parameter::CONNECTION_SSL_CONN_FAILURE  = 5
+    integer, parameter::CONNECTION_OPEN              = 6
+    
+    character(23), dimension(0:6), parameter:: connection_code_str = &
+        ["No Connection          ", &
+         "Connection Closed      ", &
+         "Server Not Found       ", &
+         "Local Socket Failure   ", &
+         "SSL Configuration Error", &
+         "SSL Connection Failure ", &
+         "SSL Connection Open    " ]
+           
+    
+    type :: connection
+        
+        integer::code
+        
+        type(simple_hostent)::host
+        integer::socket
+        type(c_ptr)::ssl_ctx
+        type(c_ptr)::ssl
+    
+    end type connection
+
+contains
+
+    function translate_connection_code(code)
+    implicit none
+    
+        integer, intent(in)::code
+        character(23)::translate_connection_code
+        
+        if(code >= lbound(connection_code_str, 1) .and. &
+           code <= ubound(connection_code_str, 1)) then
+        
+            translate_connection_code = connection_code_str(code)
+            
+        else
+            
+            translate_connection_code = "Unknown Error"
+            
+        end if
+        
+    end function translate_connection_code
+
+    function open_connection(server, port) result(conn)
+    use jessl
+    use network
+    implicit none
+    
+        character(*), intent(in)::server
+        integer, intent(in), optional::port
+        type(connection)::conn
+        
+        type(sockaddr_in), target::sa
+        type(c_ptr)::ssl_method
+        
+        conn%code = CONNECTION_NONE
+
+        ! Lookup host
+        conn%host = gethostbyname(server)
+        if((.not. allocated(conn%host%h_name)) .or. (conn%host%h_addr4 == 0)) then
+            conn%code = CONNECTION_SERVER_NOT_FOUND
+            return
+        end if
+
+        ! Build the socket
+        sa%sin_family = AF_INET
+        sa%sin_addr%s_addr = conn%host%h_addr4
+        if(present(port)) then
+            sa%sin_port = htons(port)
+        else
+            sa%sin_port = htons(1965)
+        end if
+        conn%socket = socket(AF_INET, SOCK_STREAM, 0)
+        if(.not. connect(conn%socket, sa)) then
+            conn%code = CONNECTION_SOCKET_FAILURE
+            return
+        end if
+        
+        ! Set up ssl now
+        ssl_method = tls_client_method()
+        conn%ssl_ctx = ctx_new(ssl_method)
+        
+        conn%ssl = ssl_new(conn%ssl_ctx)
+        if((.not. c_associated(conn%ssl)) .or. &
+           (set_tlsext_host_name(conn%ssl, server) == 0) .OR. &
+           (set_fd(conn%ssl, conn%socket) /= 1)) then
+           
+            conn%code = CONNECTION_SSL_SETUP_FAILURE
+            return
+            
+        end if
+        
+        ! Connect via ssl
+        if(ssl_connect(conn%ssl) /= 1) then
+            conn%code = CONNECTION_SSL_CONN_FAILURE
+            return
+        end if
+        
+        ! Here, the connection is live
+        conn%code = CONNECTION_OPEN
+
+    end function open_connection
+    
+    subroutine close_connection(conn)
+    use jessl
+    use network
+    implicit none
+    
+        type(connection), intent(inout)::conn
+        integer::res
+        
+        if(conn%code >= CONNECTION_OPEN) then
+            res = ssl_shutdown(conn%ssl)
+        end if
+        
+        if(conn%code >= CONNECTION_SSL_CONN_FAILURE) then
+            res = ssl_free(conn%ssl)
+        end if
+        
+        if(conn%code >= CONNECTION_SSL_SETUP_FAILURE) then
+            res = ctx_free(conn%ssl_ctx)
+        end if
+        
+        if(conn%code > CONNECTION_SOCKET_FAILURE) then
+            call close_socket(conn%socket)
+        end if
+        
+        if(conn%code > CONNECTION_SERVER_NOT_FOUND) then
+            deallocate(conn%host%h_name)
+        end if
+        
+        conn%code = CONNECTION_CLOSED
+        
+    end subroutine close_connection
+    
+    subroutine get_server_from_url(url, server, port)
+    implicit none
+    
+        character(*), intent(in)::url
+        character(*), intent(out)::server
+        integer, intent(out), optional::port
+        
+        integer::start_server, end_server, length
+        integer::start_port, iostatus
+        integer::myport
+        
+        myport = -1
+        
+        start_server = index(url, "://")
+        if(start_server > 0) then
+        
+            start_server = start_server + 3
+            end_server = index(url(start_server:len_trim(url)), "/")
+            if(end_server <= 0) then
+                end_server = len_trim(url)
+            else
+                ! Get rid of trailing slash
+                end_server = end_server + start_server - 2
+            end if
+            length = end_server - start_server + 1
+    
+            server = url(start_server:end_server)
+            
+        end if
+        
+        ! Need to check if a port was specified too
+        start_port = index(server, ":")
+        if(start_port > 0) then
+        
+            read(server(start_port+1:len_trim(server)), *, iostat=iostatus) myport
+            if(iostatus /= 0) then
+                myport = -1
+            end if
+            
+            server = server(1:start_port-1)
+        
+        end if
+        
+        if(present(port)) then
+            port = myport
+        end if
+    
+    end subroutine get_server_from_url
+
+    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
diff --git a/common/wsa.f90 b/common/wsa.f90
new file mode 100644
index 0000000..080da11
--- /dev/null
+++ b/common/wsa.f90
@@ -0,0 +1,68 @@
+! 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 wsa_network
+use iso_c_binding
+implicit none
+
+    integer, parameter::wsa_description_length_plus_1 = 256
+
+    type, bind(c) :: wsadata
+        integer(kind=c_int16_t)::wVersion
+        integer(kind=c_int16_t)::wHighVersion
+        integer(kind=c_short)::iMaxSockets
+        integer(kind=c_short)::iMaxUdpDg
+        
+        type(c_ptr)::lpVendorInfo
+        character(len=1, kind=c_char), dimension(wsa_description_length_plus_1)::szDescription
+        character(len=1, kind=c_char), dimension(wsa_description_length_plus_1)::szSystemStatus
+    end type
+    
+contains
+
+    subroutine startup()
+    use iso_c_binding
+    implicit none
+    
+        interface
+            function wsa_startup(v, p) bind(c, name="WSAStartup")
+            use iso_c_binding
+            integer(kind=c_int16_t), value::v
+            type(c_ptr), value::p
+            integer(kind=c_int)::wsa_startup
+            end function wsa_startup
+        end interface
+        
+        type(wsadata), target::startup_data
+        integer::res
+        
+        ! need to use wVersionRequested = MAKEWORD(2, 2);
+        
+        
+        res = wsa_startup(int(z'0202', kind=c_int16_t), c_loc(startup_data))
+        if(res /= 0) then
+            Print *, "Windows Networking failed to start"
+            Print *, "Error=", res
+            stop
+        end if
+    end subroutine startup
+end module wsa_network
diff --git a/player/config.f90 b/player/config.f90
new file mode 100644
index 0000000..96c775c
--- /dev/null
+++ b/player/config.f90
@@ -0,0 +1,8 @@
+module config
+implicit none
+
+    character(len=:), pointer::working_directory
+    character(len=:), pointer::logfile
+    character(len=1024)::captain
+    character(len=36)::token
+end module config
diff --git a/player/instructions.f90 b/player/instructions.f90
new file mode 100644
index 0000000..8c671c4
--- /dev/null
+++ b/player/instructions.f90
@@ -0,0 +1,198 @@
+module instructions
+implicit none
+
+contains
+
+    function parse_instructions(filename) result(j)
+    use json_module
+    implicit none
+    
+        type(json_file)::j
+        character(*), intent(in)::filename
+        
+        call j%initialize()
+        call j%load_file(filename=filename)
+        
+    end function parse_instructions
+    
+    subroutine destroy_instructions(j)
+    use json_module
+    implicit none
+    
+        type(json_file)::j
+        call j%destroy()
+    
+    end subroutine destroy_instructions
+    
+    subroutine get_description(j, description)
+    use json_module
+    implicit none
+    
+        class(json_file)::j
+        character(*), intent(out)::description
+        character(len=:), allocatable::json_string_value
+        logical::found
+        
+        call j%get("description", json_string_value, found)
+        if(.not. found .or. .not. allocated(json_string_value)) then
+            description = "(instructions)"
+        else
+            description = json_string_value
+        end if
+        
+    end subroutine get_description
+    
+    function get_task_count(j) result(n)
+    use json_module
+    implicit none
+    
+        class(json_file)::j
+        integer::n
+        
+        type(json_value), pointer ::server
+        logical::found
+        character(3)::index_string
+        n = 0
+        
+        found = .true.
+        do while(found)
+            n = n + 1
+            write(index_string, '(I3)') n
+            call j%get("tasks("//trim(index_string)//")", server, found)
+        end do
+        n = n - 1
+        
+    end function get_task_count
+    
+    pure subroutine task_component(i, component, label)
+    implicit none
+        
+        integer, intent(in)::i
+        character(*), intent(in)::component
+        character(*), intent(out)::label
+        
+        write(label, '(A6,I3,A2)') "tasks(", i, ")."
+        label = label//trim(component)
+    
+    end subroutine task_component
+    
+    function get_task_string(j, i, component, res) result(found)
+    use json_module
+    implicit none
+        
+        class(json_file)::j
+        integer, intent(in)::i
+        character(*), intent(in)::component
+        character(*), intent(out)::res
+        logical::found
+        
+        character(len=64)::label
+        character(len=:), allocatable::json_string_value
+        
+        call task_component(i, component, label)
+        
+        call j%get(trim(label), json_string_value, found)
+        
+        if(allocated(json_string_value)) then
+            res = json_string_value
+        end if
+        
+    end function get_task_string
+    
+    subroutine get_task_name(j, i, description)
+    use json_module
+    implicit none
+    
+        class(json_file)::j
+        character(*), intent(out)::description
+        integer, intent(in)::i
+        logical::found
+
+        found = get_task_string(j, i, "name", description)
+        
+        if(.not. found) then
+            write(description, '(A4, 1X, I3)') "Task", i
+        end if
+        
+    end subroutine get_task_name
+    
+    subroutine get_task_operation(j, i, op)
+    use json_module
+    implicit none
+    
+        class(json_file)::j
+        character(*), intent(out)::op
+        integer, intent(in)::i
+        logical::found
+
+        found = get_task_string(j, i, "operation", op)
+        
+        if(.not. found) then
+            op = " "
+        end if
+        
+    end subroutine get_task_operation
+
+    function perform_task(j, i, capture_filename) result(success)
+    use json_module
+    use tasks
+    use utilities
+    implicit none
+    
+        class(json_file)::j
+        integer, intent(in)::i
+        character(len=:), pointer, intent(out)::capture_filename
+        logical::success
+        
+        character(32)::operation
+        character(256)::url
+        character(256)::filename
+        
+        logical, dimension(4)::found
+        
+        call get_task_operation(j, i, operation)
+        
+        found = .true.
+        capture_filename => null()
+        
+        if(trim(operation) == "upload") then
+            found(1) = get_task_string(j, i, "url", url)
+            found(2) = get_task_string(j, i, "filename", filename)
+            if(.not. all(found,1)) then
+                success = .false.
+            else
+                success = upload(url, filename)
+            end if
+        
+        else if(trim(operation) == "download") then
+            found(1) = get_task_string(j, i, "url", url)
+            found(2) = get_task_string(j, i, "filename", filename)
+            if(.not. all(found,1)) then
+                success = .false.
+            else
+                success = download(url, filename)
+            end if
+        
+        else if(trim(operation) == "git_update") then
+            capture_filename => generate_temporary_filename()
+        
+            found(1) = get_task_string(j, i, "url", url)
+            found(2) = get_task_string(j, i, "filename", filename)
+            if(.not. all(found,1)) then
+                success = .false.
+            else
+                success = download(url, filename)
+            end if
+        
+        
+        else if(trim(operation) == "shell") then
+        
+        
+        else if(trim(operation) == "delete_tree") then
+        
+        
+        end if
+        
+    end function perform_task
+    
+end module instructions
\ No newline at end of file
diff --git a/player/levitating-player.prj b/player/levitating-player.prj
new file mode 100644
index 0000000..b6a36a4
--- /dev/null
+++ b/player/levitating-player.prj
@@ -0,0 +1,96 @@
+{
+  "Root":{
+    "Folders":[{
+        "Folders":[],
+        "Name":"+common",
+        "Files":[{
+            "filename":"..\\common\\jessl.f90",
+            "enabled":"1"
+          },{
+            "filename":"..\\common\\network.F90",
+            "enabled":"1"
+          },{
+            "filename":"..\\common\\protocol.f90",
+            "enabled":"1"
+          },{
+            "filename":"..\\common\\request.f90",
+            "enabled":"1"
+          },{
+            "filename":"..\\common\\wsa.f90",
+            "enabled":"1"
+          }]
+      }],
+    "Name":"+levitating-player (target.exe)",
+    "Files":[{
+        "filename":".\\config.f90",
+        "enabled":"1"
+      },{
+        "filename":".\\instructions.f90",
+        "enabled":"1"
+      },{
+        "filename":".\\main.f90",
+        "enabled":"1"
+      },{
+        "filename":".\\tasks.f90",
+        "enabled":"1"
+      },{
+        "filename":".\\utilities.F90",
+        "enabled":"1"
+      }]
+  },
+  "Name":"levitating-player (target.exe)",
+  "Options":{
+    "Compiler Options":{
+      "Fortran Flags":"",
+      "Link Flags":"",
+      "C Flags":""
+    },
+    "Architecture":1,
+    "Type":0,
+    "Revision":2,
+    "Windows GUI":0,
+    "File Options":{
+      "Library Directories":["Default Add-On Directory"],
+      "Build Directory":"build",
+      "Module Directory":"modules",
+      "Include Directories":["Default Add-On Include Directory"]
+    },
+    "Target":"target.exe",
+    "Fortran Options":{
+      "Use C Preprocessor":"false",
+      "Runtime Diagnostics":"false",
+      "Floating Point Exception Trap":0,
+      "Cray Pointers":"false",
+      "Enable Coarrays":"false",
+      "Enable OpenMP":"false",
+      "Initialize Variables to Zero":"false",
+      "Default Double for Real":"false"
+    },
+    "Code Generation Options":{
+      "CPU Specific":"false",
+      "Processor":"generic",
+      "Aggressive Loops":"false",
+      "Debugging":"true",
+      "Optimization Mode":0,
+      "Profiling":"false"
+    },
+    "Build Dependencies":1,
+    "Launch Options":{
+      "Working Directory":"",
+      "Launch Using MPI":"false",
+      "Keep Console":"true",
+      "External Console":"false",
+      "Command Line Arguments":"",
+      "Build Before Launch":"true"
+    },
+    "Build Options":{
+      "Makefile":"Makefile",
+      "Auto Makefile":"true"
+    },
+    "Linker Options":{
+      "Static Linking Mode":7,
+      "Link MPI Library":"false",
+      "Link LAPACK":0
+    }
+  }
+}
\ No newline at end of file
diff --git a/player/main.f90 b/player/main.f90
new file mode 100644
index 0000000..cdf646e
--- /dev/null
+++ b/player/main.f90
@@ -0,0 +1,87 @@
+program player
+use config
+implicit none
+
+    character(len=1024)::option
+
+    integer::slen
+    integer::i
+    
+    i = 1
+    do while(i <= command_argument_count())
+        call get_command_argument(i, option)
+    
+        if(option(1:1) /= "-") then
+            captain = option
+    
+        else if(trim(option) == "-h") then
+            call usage()
+            stop
+        
+        else if(trim(option) == "-w") then
+            i = i + 1
+            call get_command_argument(i, length=slen)
+            allocate(character(len=slen) :: working_directory)
+            call get_command_argument(i, working_directory)
+            
+        else if(trim(option) == "-l") then
+            i = i + 1
+            call get_command_argument(i, length=slen)
+            allocate(character(len=slen) :: logfile)
+            call get_command_argument(i, logfile)
+            
+        end if
+        
+        i = i + 1
+    end do
+    
+    ! Assign working directory from command if not specified
+    if(.not. associated(working_directory)) then
+        call get_command_argument(0, length=slen)
+        allocate(character(len=slen) :: working_directory)
+        call get_command_argument(i, working_directory)
+        i = index(working_directory, "/", back=.true.)
+        if(i == 0) then
+            i = index(working_directory, "/", back=.true.)
+        endif
+        if(i == 0) then
+            Print *, "Could not determine working_directory"
+            stop
+        else
+            working_directory(i:slen) = ' '
+        end if
+    end if
+    
+    ! Assign a temporary directory and file for a log file
+    ! NOTE: will fail on Windows
+    if(.not. associated(logfile)) then
+        allocate(character(len=256) :: logfile)
+        logfile = "/tmp/levitating.log"
+    end if
+        
+    ! Change directory to the working directory now
+    call chdir(working_directory)
+        
+    
+contains
+
+    subroutine usage()
+    implicit none
+    
+        character(len=256)::pname
+        
+        call get_command_argument(0, pname)
+    
+        Print *, "Usage: "//trim(pname)//" <options> <captain>"
+        Print *, " "
+        Print *, "captain is the build control server"
+        Print *, " "
+        
+        Print *, "Options:"
+        Print *, "    -h          Display this help"
+        Print *, "    -w <dir>    Use dir as the working directory"
+        Print *, "    -l <log>    Use log as the logfile"
+        
+    end subroutine usage
+    
+end program player
\ No newline at end of file
diff --git a/player/tasks.f90 b/player/tasks.f90
new file mode 100644
index 0000000..c64cb40
--- /dev/null
+++ b/player/tasks.f90
@@ -0,0 +1,216 @@
+module tasks
+implicit none
+
+contains
+
+    function shell(command, directory, capture_filename)
+    use config
+    use utilities
+    implicit none
+    
+        logical::shell
+        character(*), intent(in)::command
+        character(*), intent(in)::directory
+        character(*), intent(in)::capture_filename
+        
+        character(len=:), allocatable::task_directory
+        
+        integer::return_value, details_unit
+        integer, dimension(8)::timedate_start, timedate_end
+        
+        shell = .false.
+        
+        if(is_absolute_path(directory)) then
+            call chdir(directory)
+        else
+            allocate(character(len=(len_trim(directory) + len_trim(working_directory) + 1)) :: task_directory)
+            call combine_paths(working_directory, directory, task_directory)
+            call chdir(task_directory)
+        end if
+        
+        call date_and_time(values=timedate_start)
+        
+        call execute_command_line(trim(command)//" 1>> "//trim(capture_filename)//" 2>&1", &
+                                  wait=.true., exitstat=return_value)
+        
+        shell = (return_value == 0)
+        
+        ! Write out some final info
+        open(newunit=details_unit, file=capture_filename, status="old", access="append")
+        write(details_unit, *) repeat("=", 80)
+        write(details_unit, '(1X, A25, I3)') "Task Completed with Code ", return_value
+        
+        call date_and_time(values=timedate_end)
+        
+        write(details_unit, '(1X, A8, 1X)', advance='no') "Started:"
+        call write_date_and_time(details_unit, timedate_start)
+        
+        write(details_unit, '(1X, A8, 1X)', advance='no') "  Ended:"
+        call write_date_and_time(details_unit, timedate_end)
+        
+        write(details_unit, *) "Command:"
+        write(details_unit, *) "    "//trim(command)
+        
+        write(details_unit, *) "Working Directory:"
+        if(allocated(task_directory)) then
+            write(details_unit, *) "    "//trim(task_directory)
+        else
+            write(details_unit, *) "    "//trim(directory)
+        end if
+        
+        write(details_unit, *) repeat("=", 80)
+        close(details_unit)
+        
+        call chdir(working_directory)
+        
+        if(allocated(task_directory)) then
+            deallocate(task_directory)
+        end if
+        
+    end function shell
+
+    function upload(url, source_filename)
+    use config, only: token
+    use gemini_protocol, only: titan_post_url, STATUS_SUCCESS
+    implicit none
+    
+        logical::upload
+        character(*), intent(in)::url
+        character(*), intent(in)::source_filename
+        
+        character(len=:), allocatable::mod_url
+        
+        integer(kind=8)::file_size
+        integer::unit_number, istatus
+        
+        inquire(file=source_filename, size=file_size)
+        
+        open(newunit=unit_number, file=trim(source_filename), status='UNKNOWN', &
+             access='STREAM', form='UNFORMATTED', iostat=istatus)
+        
+        allocate(character(len=len_trim(url)) :: mod_url)
+        mod_url = url
+        
+        if(istatus == 0) then
+            istatus = titan_post_url(mod_url, unit_number, file_size, token)
+            upload = (istatus == STATUS_SUCCESS)
+            close(unit_number)
+        else
+            upload = .false.
+        end if
+        
+        deallocate(mod_url)
+        
+    end function upload
+    
+    function download(url, destination_filename)
+    use gemini_protocol, only: request_url, STATUS_SUCCESS
+    implicit none
+    
+        logical::download
+        character(*), intent(in)::url
+        character(*), intent(in)::destination_filename
+        
+        character(len=256)::mimetype
+        
+        character(len=:), allocatable::mod_url
+        
+        integer::unit_number, istatus
+        
+        allocate(character(len=len_trim(url)) :: mod_url)
+        mod_url = url
+        
+        open(newunit=unit_number, file=trim(destination_filename), status='UNKNOWN', &
+             access='STREAM', form='UNFORMATTED', iostat=istatus)
+        
+        if(istatus == 0) then
+            istatus = request_url(mod_url, unit_number, mimetype)
+            download = (istatus == STATUS_SUCCESS)
+            close(unit_number)
+        else
+            download = .false.
+        end if
+        
+        deallocate(mod_url)
+        
+    end function download
+
+    function git_update(origin, branch, directory, destructive, capture_filename)
+    use config
+    implicit none
+    
+        logical::git_update
+        character(*), intent(in)::origin
+        character(*), intent(in)::directory
+        character(*), intent(in)::branch
+        logical, intent(in)::destructive
+        character(*), intent(in)::capture_filename
+        
+        logical::res
+        integer::retval
+        character(len=32)::options
+
+        ! If we're working in destructive mode, just checkout the current head
+        if(destructive) then
+            res = delete_tree(directory)
+            options = " --depth 1"
+        else
+            options = " "
+        end if
+        
+        call execute_command_line("mkdir "//trim(directory), wait=.true., exitstat=retval)
+        
+        ! If Zero, there is no existing directory...
+        if(retval == 0) then
+            res = shell("git clone"//trim(options)//" "//trim(origin)//" "//trim(directory), working_directory, capture_filename)
+            if(res) then
+                res = shell("git submodule init", directory, capture_filename)
+            end if
+        else
+            res = .true.
+        end if
+        
+        ! Check that nothing went wrong so far...
+        if(res) then
+            res = shell("git checkout "//trim(branch), directory, capture_filename)
+            if(res) then
+                res = shell("git submodule update", directory, capture_filename)
+            end if
+        end if
+        
+        git_update = res
+        
+    end function git_update
+
+    function delete_tree(directory)
+    use config, only: working_directory
+    use utilities
+    implicit none
+    
+        logical::delete_tree
+        character(*), intent(in)::directory
+        character(len=:), allocatable::fulldir
+        
+        ! Only proceed in the working directory...
+        ! Relative paths could still break this, but what can you do...
+        if(is_absolute_path(directory)) then
+            delete_tree = .false.
+        else
+            
+            allocate(character(len=( len_trim(working_directory)+len_trim(directory)+1 )) :: fulldir)
+            call combine_paths(working_directory, directory, fulldir)
+            
+            ! No spaces allowed.  Tough...
+            if(index(fulldir, " ") /= 0) then
+                delete_tree = .false.
+            else
+                delete_tree = remove_directory(fulldir)
+            end if
+            
+            deallocate(fulldir)
+            
+        end if
+    
+    end function delete_tree
+
+end module tasks
diff --git a/player/utilities.F90 b/player/utilities.F90
new file mode 100644
index 0000000..c7fd523
--- /dev/null
+++ b/player/utilities.F90
@@ -0,0 +1,208 @@
+module utilities
+
+#ifdef WINDOWS
+    character, parameter::dir_sep = '\'
+#else
+    character, parameter::dir_sep = '/'
+#endif
+
+contains
+
+    function is_absolute_path(path)
+    implicit none
+    
+        logical::is_absolute_path
+        character(len=*), intent(in)::path
+        
+        is_absolute_path = .false.
+        if(path(1:1) == dir_sep) then
+            is_absolute_path = .true.
+        else
+#ifdef WINDOWS
+            if(path(2:2) == ":") then
+                is_absolute_path = .true.
+            end if
+#endif
+        end if
+        
+    end function is_absolute_path
+        
+    subroutine combine_paths(first, second, res)
+    implicit none
+    
+        character(len=*), intent(in)::first, second
+        character(len=*), intent(out)::res
+    
+        integer::i
+        
+        i = len_trim(first)
+    
+        if(first(i:i) == dir_sep) then
+            res = trim(first)//trim(second)
+        else
+            res = trim(first)//dir_sep//trim(second)
+        end if
+        
+    end subroutine combine_paths
+    
+    subroutine write_date_and_time(unit_number, values)
+    implicit none
+    
+        integer, intent(in)::unit_number
+        integer, intent(in), dimension(8)::values
+
+        write(unit_number, '(I4, A1, I2, A1, I2, 1X, I2, A1, I2, A1, I2)') &
+            values(1), "-", &
+            values(2), "-", &
+            values(3),  &
+            values(5), ":", &
+            values(6), ":", &
+            values(7)
+
+    end subroutine write_date_and_time
+    
+    function remove_directory(absolute_dir, and_files)
+    implicit none
+    
+        character(*), intent(in)::absolute_dir
+        logical, intent(in), optional::and_files
+        logical::remove_directory
+        
+        character(len=8)::cmd, flags
+        integer::retval
+        
+#ifdef WINDOWS        
+        flags = " "
+        cmd = "rmdir"
+#else
+        flags = "-r"
+        cmd = "rm"
+#endif
+
+        if(present(and_files)) then
+            if(and_files) then
+#ifdef WINDOWS
+                flags = "/S /Q"
+#else
+                flags = "-rf"
+#endif
+            end if
+        end if
+        
+        call execute_command_line(trim(cmd)//" "//trim(flags)//" "//trim(absolute_dir), &
+                                  wait=.true., exitstat=retval)
+            
+        remove_directory = (retval == 0)
+        
+    end function remove_directory
+    
+    function read_into_buffer(unit_number, buffer)
+    implicit none
+    
+        integer, intent(in)::unit_number
+        character, dimension(*), intent(out)::buffer
+        integer::read_into_buffer
+        
+        integer::i, ierr
+        
+        ierr = 0
+        i = 0
+        do while(ierr == 0 .and. i < len(buffer))
+            i = i + 1
+            read(unit_number, iostat=ierr) buffer(i)
+        end do
+            
+        if(ierr /= 0) then
+            i = i - 1
+        end if
+        
+        read_into_buffer = i
+    
+    end function read_into_buffer
+    
+    function generate_temporary_filename() result(fullpath)
+    use iso_c_binding
+    implicit none
+    
+        character(len=:), pointer::fullpath
+        type(c_ptr)::tmp_name
+        character(kind=c_char), dimension(:), pointer::cfullpath
+        integer(kind=c_size_t)::clength
+        integer::i
+        
+        interface
+            function c_strlen(p) bind(c, name='strlen')
+            use iso_c_binding
+            type(c_ptr), value::p
+            integer(kind=c_size_t)::strlen
+            end function c_strlen
+            
+            function c_malloc(x) bind(c, name='malloc')
+            use iso_c_binding
+            type(c_ptr)::c_malloc
+            integer(kind=c_size_t), value::x
+            end function c_malloc
+            
+            subroutine c_free(p) bind(c, name='free')
+            use iso_c_binding
+            type(c_ptr), value::p
+            end subroutine c_free
+            
+        end interface
+
+#ifdef WINDOWS
+        interface
+            function GetTempPath(n, b) bind(c, name='GetTempPathA')
+            use iso_c_binding
+            integer(kind=c_int32_t)::GetTempPath
+            integer(kind=c_int32_t), value::n
+            type(c_ptr), value::b
+        
+            function GetTempFileName(pn, prefix, unique, b) bind(c, name='GetTempFileNameA')
+            use iso_c_binding
+            integer(kind=c_int)::GetTempFileName
+            integer(kind=c_int), value::unique
+            type(c_ptr), value::pn, prefix, b
+            end function GetTempFileName
+        end interface
+        
+        type(c_ptr)::tmp_path
+        integer::res
+        
+        tmp_path = c_malloc(1024)
+        res = GetTempPath(1023, tmp_path)
+        
+        tmp_name = c_malloc(1024)
+        res = GetTempFileName(tmp_path, c_null_ptr(), 0, tmp_name)
+        
+        c_free(tmp_path)
+#else
+        interface
+            function tmpnam(p) bind(c, name='tmpnam')
+            use iso_c_binding
+            type(c_ptr), value::p
+            type(c_ptr)::tmpnam
+            end function tmpnam
+        end interface
+        
+        type(c_ptr)::ignored
+        
+        tmp_name = c_malloc(int(1024, kind=c_size_t))
+        
+        ignored = tmpnam(tmp_name)
+#endif
+
+        ! Convert the C Ptr to a Fortran object
+        clength = c_strlen(tmp_name)
+        call c_f_pointer(tmp_name, cfullpath, (/ clength /))
+        allocate(character(len=clength)::fullpath)
+        do i = 1, clength
+            fullpath(i:i) = cfullpath(i)
+        end do
+        
+        cfullpath => null()
+        call c_free(tmp_name)
+        
+    end function generate_temporary_filename
+    
+end module utilities
\ No newline at end of file