Stub out authentication and connection layers.
This commit is contained in:
Tony Garnock-Jones
parent
a7e26dcccd
commit
98e19dc92e
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue