diff --git a/ssh-message-types.rkt b/ssh-message-types.rkt index eb0a27b..d1ced6b 100644 --- a/ssh-message-types.rkt +++ b/ssh-message-types.rkt @@ -29,7 +29,26 @@ (struct-out ssh-msg-newkeys) (struct-out ssh-msg-debug) (struct-out ssh-msg-ignore) - (struct-out ssh-msg-service-request)) + (struct-out ssh-msg-service-request) + (struct-out ssh-msg-service-accept) + (struct-out ssh-msg-userauth-request) + (struct-out ssh-msg-userauth-failure) + (struct-out ssh-msg-userauth-success) + (struct-out ssh-msg-global-request) + (struct-out ssh-msg-request-success) + (struct-out ssh-msg-request-failure) + (struct-out ssh-msg-channel-open) + (struct-out ssh-msg-channel-open-confirmation) + (struct-out ssh-msg-channel-open-failure) + (struct-out ssh-msg-channel-window-adjust) + (struct-out ssh-msg-channel-data) + (struct-out ssh-msg-channel-extended-data) + (struct-out ssh-msg-channel-eof) + (struct-out ssh-msg-channel-close) + (struct-out ssh-msg-channel-request) + (struct-out ssh-msg-channel-success) + (struct-out ssh-msg-channel-failure) + ) (struct ssh-msg () #:transparent) @@ -112,7 +131,8 @@ (uint64 #'(integer bits 64)) (string #'((t:string))) (mpint #'((t:mpint))) - (name-list #'((t:name-list))))) + (name-list #'((t:name-list))) + (extension #'(binary)))) (define-syntax compute-ssh-message-encoder (lambda (stx) @@ -233,3 +253,79 @@ (define-ssh-message-type ssh-msg-service-request SSH_MSG_SERVICE_REQUEST (string service-name)) + +(define-ssh-message-type ssh-msg-service-accept SSH_MSG_SERVICE_ACCEPT + (string service-name)) + +(define-ssh-message-type ssh-msg-userauth-request SSH_MSG_USERAUTH_REQUEST + (string user-name) + (string service-name) + (string method-name) + (extension method-specific-fields)) + +(define-ssh-message-type ssh-msg-userauth-failure SSH_MSG_USERAUTH_FAILURE + (name-list continuable-authentications) + (boolean partial-success?)) + +(define-ssh-message-type ssh-msg-userauth-success SSH_MSG_USERAUTH_SUCCESS) + +(define-ssh-message-type ssh-msg-global-request SSH_MSG_GLOBAL_REQUEST + (string request-name) + (boolean want-reply?) + (extension data)) + +(define-ssh-message-type ssh-msg-request-success SSH_MSG_REQUEST_SUCCESS + (extension data)) + +(define-ssh-message-type ssh-msg-request-failure SSH_MSG_REQUEST_FAILURE) + +(define-ssh-message-type ssh-msg-channel-open SSH_MSG_CHANNEL_OPEN + (string channel-type) + (uint32 sender-channel) + (uint32 initial-window-size) + (uint32 maximum-packet-size) + (extension data)) + +(define-ssh-message-type ssh-msg-channel-open-confirmation SSH_MSG_CHANNEL_OPEN_CONFIRMATION + (uint32 recipient-channel) + (uint32 sender-channel) + (uint32 initial-window-size) + (uint32 maximum-packet-size) + (extension data)) + +(define-ssh-message-type ssh-msg-channel-open-failure SSH_MSG_CHANNEL_OPEN_FAILURE + (uint32 recipient-channel) + (uint32 reason) + (string description) + (string language)) + +(define-ssh-message-type ssh-msg-channel-window-adjust SSH_MSG_CHANNEL_WINDOW_ADJUST + (uint32 recipient-channel) + (uint32 bytes)) + +(define-ssh-message-type ssh-msg-channel-data SSH_MSG_CHANNEL_DATA + (uint32 recipient-channel) + (string data)) + +(define-ssh-message-type ssh-msg-channel-extended-data SSH_MSG_CHANNEL_EXTENDED_DATA + (uint32 recipient-channel) + (uint32 type-code) + (string data)) + +(define-ssh-message-type ssh-msg-channel-eof SSH_MSG_CHANNEL_EOF + (uint32 recipient-channel)) + +(define-ssh-message-type ssh-msg-channel-close SSH_MSG_CHANNEL_CLOSE + (uint32 recipient-channel)) + +(define-ssh-message-type ssh-msg-channel-request SSH_MSG_CHANNEL_REQUEST + (uint32 recipient-channel) + (string type) + (boolean want-reply?) + (extension data)) + +(define-ssh-message-type ssh-msg-channel-success SSH_MSG_CHANNEL_SUCCESS + (uint32 recipient-channel)) + +(define-ssh-message-type ssh-msg-channel-failure SSH_MSG_CHANNEL_FAILURE + (uint32 recipient-channel)) diff --git a/ssh-session.rkt b/ssh-session.rkt index cd4ec1c..bb343bc 100644 --- a/ssh-session.rkt +++ b/ssh-session.rkt @@ -38,6 +38,15 @@ (struct rekey-local (local-algorithms) #:transparent) (struct rekey-in-progress (state) #:transparent) +;; An AuthenticationState is one of +;; - #f, for not-yet-authenticated +;; - an (authenticated String String), recording successful completion +;; of the authentication protocol after a request to be identified +;; as the given username for the given service. +;; TODO: When authentication is properly implemented, we will need +;; intermediate states here too. +(struct authenticated (username service) #:transparent) + ;; A PacketDispatcher is a Hashtable mapping Byte to PacketHandler. ;; A PacketHandler is a (Bytes DecodedPacket ConnectionState -> ConnectionState). @@ -54,6 +63,7 @@ dispatch-table total-transferred rekey-state + authentication-state is-server? local-id remote-id @@ -435,8 +445,91 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (handle-msg-service-request packet message conn) - (disconnect-with-error SSH_DISCONNECT_SERVICE_NOT_AVAILABLE - "%%%")) + (define service (bit-string->bytes (ssh-msg-service-request-service-name message))) + (match service + (#"ssh-userauth" + (if (connection-authentication-state conn) + (disconnect-with-error SSH_DISCONNECT_SERVICE_NOT_AVAILABLE + "Repeated authentication is not permitted") + (begin + (write-message!/flush (ssh-msg-service-accept service) conn) + (oneshot-handler conn + SSH_MSG_USERAUTH_REQUEST + handle-msg-userauth-request)))) + (else + (disconnect-with-error SSH_DISCONNECT_SERVICE_NOT_AVAILABLE + "Service ~v not supported" + service)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; User authentication +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (handle-msg-userauth-request packet message conn) + (define user-name (bit-string->bytes (ssh-msg-userauth-request-user-name message))) + (define service-name (bit-string->bytes (ssh-msg-userauth-request-service-name message))) + (cond + ((and (positive? (bytes-length user-name)) + (equal? service-name #"ssh-connection")) + ;; TODO: Actually implement client authentication + (write-message!/flush (ssh-msg-userauth-success) conn) + (start-connection-service + (set-handlers (struct-copy connection conn + [authentication-state (authenticated user-name service-name)]) + SSH_MSG_USERAUTH_REQUEST + (lambda (packet message conn) + ;; RFC4252 section 5.1 page 6 + conn)))) + (else + (write-message!/flush (ssh-msg-userauth-failure '(none) #f) conn) + conn))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Connection service +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (start-connection-service conn) + (set-handlers conn + SSH_MSG_GLOBAL_REQUEST handle-msg-global-request + SSH_MSG_CHANNEL_OPEN handle-msg-channel-open + SSH_MSG_CHANNEL_WINDOW_ADJUST handle-msg-window-adjust + SSH_MSG_CHANNEL_DATA handle-msg-channel-data + SSH_MSG_CHANNEL_EXTENDED_DATA handle-msg-channel-extended-data + SSH_MSG_CHANNEL_EOF handle-msg-channel-eof + SSH_MSG_CHANNEL_CLOSE handle-msg-channel-close + SSH_MSG_CHANNEL_REQUEST handle-msg-channel-request)) + +(define (handle-msg-global-request packet message conn) + (log-error "Unimplemented: handle-msg-global-request") + conn) + +(define (handle-msg-channel-open packet message conn) + (log-error "Unimplemented: handle-msg-channel-open") + conn) + +(define (handle-msg-window-adjust packet message conn) + (log-error "Unimplemented: handle-msg-window-adjust") + conn) + +(define (handle-msg-channel-data packet message conn) + (log-error "Unimplemented: handle-msg-channel-data") + conn) + +(define (handle-msg-channel-extended-data packet message conn) + (log-error "Unimplemented: handle-msg-channel-extended-data") + conn) + +(define (handle-msg-channel-eof packet message conn) + (log-error "Unimplemented: handle-msg-channel-eof") + conn) + +(define (handle-msg-channel-close packet message conn) + (log-error "Unimplemented: handle-msg-channel-close") + conn) + +(define (handle-msg-channel-request packet message conn) + (log-error "Unimplemented: handle-msg-channel-request") + conn) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Session main loop @@ -599,6 +692,7 @@ base-packet-dispatcher 0 (rekey-in-seconds-or-bytes -1 -1 0) + #f (case role ((client) #f) ((server) #t)) local-identification-string peer-identification-string