Stub out authentication and connection layers.
This commit is contained in:
parent
a7e26dcccd
commit
98e19dc92e
|
@ -29,7 +29,26 @@
|
||||||
(struct-out ssh-msg-newkeys)
|
(struct-out ssh-msg-newkeys)
|
||||||
(struct-out ssh-msg-debug)
|
(struct-out ssh-msg-debug)
|
||||||
(struct-out ssh-msg-ignore)
|
(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)
|
(struct ssh-msg () #:transparent)
|
||||||
|
|
||||||
|
@ -112,7 +131,8 @@
|
||||||
(uint64 #'(integer bits 64))
|
(uint64 #'(integer bits 64))
|
||||||
(string #'((t:string)))
|
(string #'((t:string)))
|
||||||
(mpint #'((t:mpint)))
|
(mpint #'((t:mpint)))
|
||||||
(name-list #'((t:name-list)))))
|
(name-list #'((t:name-list)))
|
||||||
|
(extension #'(binary))))
|
||||||
|
|
||||||
(define-syntax compute-ssh-message-encoder
|
(define-syntax compute-ssh-message-encoder
|
||||||
(lambda (stx)
|
(lambda (stx)
|
||||||
|
@ -233,3 +253,79 @@
|
||||||
|
|
||||||
(define-ssh-message-type ssh-msg-service-request SSH_MSG_SERVICE_REQUEST
|
(define-ssh-message-type ssh-msg-service-request SSH_MSG_SERVICE_REQUEST
|
||||||
(string service-name))
|
(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-local (local-algorithms) #:transparent)
|
||||||
(struct rekey-in-progress (state) #: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 PacketDispatcher is a Hashtable mapping Byte to PacketHandler.
|
||||||
|
|
||||||
;; A PacketHandler is a (Bytes DecodedPacket ConnectionState -> ConnectionState).
|
;; A PacketHandler is a (Bytes DecodedPacket ConnectionState -> ConnectionState).
|
||||||
|
@ -54,6 +63,7 @@
|
||||||
dispatch-table
|
dispatch-table
|
||||||
total-transferred
|
total-transferred
|
||||||
rekey-state
|
rekey-state
|
||||||
|
authentication-state
|
||||||
is-server?
|
is-server?
|
||||||
local-id
|
local-id
|
||||||
remote-id
|
remote-id
|
||||||
|
@ -435,8 +445,91 @@
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(define (handle-msg-service-request packet message conn)
|
(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
|
;; Session main loop
|
||||||
|
@ -599,6 +692,7 @@
|
||||||
base-packet-dispatcher
|
base-packet-dispatcher
|
||||||
0
|
0
|
||||||
(rekey-in-seconds-or-bytes -1 -1 0)
|
(rekey-in-seconds-or-bytes -1 -1 0)
|
||||||
|
#f
|
||||||
(case role ((client) #f) ((server) #t))
|
(case role ((client) #f) ((server) #t))
|
||||||
local-identification-string
|
local-identification-string
|
||||||
peer-identification-string
|
peer-identification-string
|
||||||
|
|
Loading…
Reference in New Issue