Basics of publickey userauth
This commit is contained in:
parent
4df961db1f
commit
32595e718f
|
|
@ -21,22 +21,33 @@
|
|||
(require "ssh-channel.rkt")
|
||||
(require "ssh-message-types.rkt")
|
||||
(require "ssh-exceptions.rkt")
|
||||
(require "ssh-keys.rkt")
|
||||
(require "schemas/gen/channel.rkt")
|
||||
(require "schemas/gen/auth.rkt")
|
||||
|
||||
(module+ main
|
||||
(standard-actor-system (ds)
|
||||
(with-services [syndicate/drivers/racket-event]
|
||||
(define spec (TcpLocal "0.0.0.0" 29418))
|
||||
(at ds
|
||||
(stop-on (asserted (StreamListenerError spec $message)))
|
||||
(during/spawn (StreamConnection $source $sink spec)
|
||||
#:name (list 'ssh source)
|
||||
(session ds source sink))))))
|
||||
(define spec (TcpLocal "0.0.0.0" 29418))
|
||||
(at ds
|
||||
(stop-on (asserted (StreamListenerError spec $message)))
|
||||
(during/spawn (StreamConnection $source $sink spec)
|
||||
#:name (list 'ssh source)
|
||||
(session ds source sink (load-private-key "test-host-keys/ssh_host_ed25519_key"))))
|
||||
))
|
||||
|
||||
;; (define host-key-ed25519-public (pk-key->public-only-key host-key-ed25519-private))
|
||||
|
||||
(define test-user-private (load-private-key "test-user-key"))
|
||||
(define test-user-public (load-public-key "test-user-key.pub"))
|
||||
|
||||
(define (user-public-key-accepted? user-name public-key)
|
||||
(match* (user-name public-key)
|
||||
[(#"tonyg" (== (public-key->pieces test-user-public))) #t]
|
||||
[(_ _) #f]))
|
||||
|
||||
;;---------------------------------------------------------------------------
|
||||
|
||||
(define (session ground-ds source sink)
|
||||
(define (session ground-ds source sink host-private-key)
|
||||
(on-stop (log-info "Session VM for ~a closed" source))
|
||||
(actor-group
|
||||
#:link? #t
|
||||
|
|
@ -57,7 +68,13 @@
|
|||
(send! (inbound-credit 1))
|
||||
(spawn
|
||||
#:name 'session
|
||||
(ssh-session conn-ds ground-ds local-identification remote-identification 'server))]
|
||||
(ssh-session conn-ds
|
||||
ground-ds
|
||||
local-identification
|
||||
remote-identification
|
||||
'server
|
||||
host-private-key
|
||||
user-public-key-accepted?))]
|
||||
[else
|
||||
(log-error "Invalid peer identification string ~v" remote-identification)
|
||||
(stop-actor-system)])])
|
||||
|
|
|
|||
|
|
@ -2,29 +2,32 @@
|
|||
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
||||
;;; SPDX-FileCopyrightText: Copyright © 2011-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||
|
||||
(require racket/match)
|
||||
(require racket/port)
|
||||
(require net/base64)
|
||||
|
||||
(require bitsyntax)
|
||||
(require "crypto.rkt")
|
||||
(require "keys/ssh-keys.rkt")
|
||||
(require "ssh-message-types.rkt")
|
||||
|
||||
(module+ test (require rackunit))
|
||||
|
||||
(provide (struct-out ed25519-private-key)
|
||||
(struct-out ed25519-public-key)
|
||||
|
||||
public-key->pieces
|
||||
pieces->public-key
|
||||
|
||||
host-key-algorithm->keys
|
||||
host-key-signature
|
||||
verify-host-key-signature!
|
||||
make-key-signature
|
||||
verify-key-signature!
|
||||
|
||||
pieces->ssh-host-key
|
||||
ssh-host-key->pieces)
|
||||
pieces->ssh-key
|
||||
ssh-key->pieces
|
||||
|
||||
load-private-key
|
||||
load-public-key)
|
||||
|
||||
(require racket/match)
|
||||
(require racket/port)
|
||||
(require net/base64)
|
||||
(require (only-in racket/file file->bytes file->string))
|
||||
|
||||
(require bitsyntax)
|
||||
(require "crypto.rkt")
|
||||
(require "keys/ssh-keys.rkt")
|
||||
(require "ssh-message-types.rkt")
|
||||
|
||||
(module+ test (require rackunit))
|
||||
|
||||
(struct ed25519-private-key (q d) #:transparent)
|
||||
(struct ed25519-public-key (q) #:transparent)
|
||||
|
|
@ -49,52 +52,45 @@
|
|||
[(ed25519-public-key q)
|
||||
(datum->pk-key (list 'eddsa 'public 'ed25519 q) 'rkt-public)]))
|
||||
|
||||
(define (host-key-algorithm->keys host-key-alg)
|
||||
(case host-key-alg
|
||||
((ssh-ed25519) (values host-key-ed25519-private host-key-ed25519-public))
|
||||
(else (error 'host-key-algorithm->keys "Unsupported host-key-alg ~v" host-key-alg))))
|
||||
|
||||
(define (host-key-signature private-key host-key-alg exchange-hash)
|
||||
(case host-key-alg
|
||||
(define (make-key-signature private-key key-alg exchange-hash)
|
||||
(case key-alg
|
||||
[(ssh-ed25519)
|
||||
(define signature (pk-sign private-key exchange-hash))
|
||||
(bit-string (#"ssh-ed25519" :: (t:string))
|
||||
(signature :: (t:string)))]))
|
||||
|
||||
(define (verify-host-key-signature! public-key host-key-alg exchange-hash h-signature)
|
||||
(define (verify-key-signature! public-key key-alg exchange-hash h-signature)
|
||||
;; TODO: If we are *re*keying, worth checking here that the key hasn't *changed* either.
|
||||
(write `(TODO check-host-key!)) (newline) (flush-output) ;; actually check the identity TOFU/POP
|
||||
(case host-key-alg
|
||||
(write `(TODO check-key!)) (newline) (flush-output) ;; actually check the identity TOFU/POP
|
||||
(case key-alg
|
||||
[(ssh-ed25519)
|
||||
(define signature (bit-string-case h-signature
|
||||
([ (= #"ssh-ed25519" :: (t:string #:pack))
|
||||
(sig :: (t:string #:pack)) ]
|
||||
sig)))
|
||||
(when (not (pk-verify public-key exchange-hash signature))
|
||||
(error 'verify-host-key-signature! "Signature mismatch"))]))
|
||||
(error 'verify-key-signature! "Signature mismatch"))]))
|
||||
|
||||
(define (pieces->ssh-host-key pieces)
|
||||
(define (pieces->ssh-key pieces)
|
||||
(match pieces
|
||||
[(ed25519-public-key q)
|
||||
(bit-string (#"ssh-ed25519" :: (t:string))
|
||||
(q :: (t:string)))]))
|
||||
|
||||
(define (ssh-host-key->pieces blob)
|
||||
(define (ssh-key->pieces blob)
|
||||
(bit-string-case blob
|
||||
([ (= #"ssh-ed25519" :: (t:string #:pack))
|
||||
(q :: (t:string #:pack)) ]
|
||||
(ed25519-public-key q))))
|
||||
(ed25519-public-key q))
|
||||
(else #f)))
|
||||
|
||||
;; TODO: proper store for keys
|
||||
|
||||
(define (load-private-key filename)
|
||||
(local-require (only-in racket/file file->bytes))
|
||||
(pieces->private-key (bytes->private-key-pieces (file->bytes filename))))
|
||||
|
||||
(define host-key-ed25519-private (load-private-key "test-host-keys/ssh_host_ed25519_key"))
|
||||
(define host-key-ed25519-public (pk-key->public-only-key host-key-ed25519-private))
|
||||
|
||||
(module+ test
|
||||
(check-equal? (pk-key->datum (pieces->public-key (public-key->pieces host-key-ed25519-public))
|
||||
'SubjectPublicKeyInfo)
|
||||
(pk-key->datum host-key-ed25519-private 'SubjectPublicKeyInfo)))
|
||||
(define (load-public-key filename)
|
||||
(match (file->string filename)
|
||||
[(pregexp #px"ssh-ed25519 +(\\S+) +([^\n]*)\n$" (list _ data-base64 _comment))
|
||||
(pieces->public-key (ssh-key->pieces (base64-decode (string->bytes/utf-8 data-base64))))]
|
||||
[_ (error 'load-public-key "Cannot load key in file ~s" filename)]))
|
||||
|
|
@ -28,6 +28,7 @@
|
|||
(struct-out ssh-msg-userauth-failure)
|
||||
(struct-out ssh-msg-userauth-success)
|
||||
(struct-out ssh-msg-userauth-banner)
|
||||
(struct-out ssh-msg-userauth-pk-ok)
|
||||
(struct-out ssh-msg-global-request)
|
||||
(struct-out ssh-msg-request-success)
|
||||
(struct-out ssh-msg-request-failure)
|
||||
|
|
@ -323,6 +324,10 @@
|
|||
(string message)
|
||||
(string language))
|
||||
|
||||
(define-ssh-message-type ssh-msg-userauth-pk-ok SSH_MSG_USERAUTH_PK_OK
|
||||
(string algorithm-name)
|
||||
(string pk-blob))
|
||||
|
||||
(define-ssh-message-type ssh-msg-global-request SSH_MSG_GLOBAL_REQUEST
|
||||
(string request-name)
|
||||
(boolean want-reply?)
|
||||
|
|
|
|||
|
|
@ -72,6 +72,7 @@
|
|||
(define SSH_MSG_USERAUTH_FAILURE 51) ;[SSH-USERAUTH]
|
||||
(define SSH_MSG_USERAUTH_SUCCESS 52) ;[SSH-USERAUTH]
|
||||
(define SSH_MSG_USERAUTH_BANNER 53) ;[SSH-USERAUTH]
|
||||
(define SSH_MSG_USERAUTH_PK_OK 60) ;RFC 4252 section 7
|
||||
(define SSH_MSG_GLOBAL_REQUEST 80) ;[SSH-CONNECT]
|
||||
(define SSH_MSG_REQUEST_SUCCESS 81) ;[SSH-CONNECT]
|
||||
(define SSH_MSG_REQUEST_FAILURE 82) ;[SSH-CONNECT]
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@
|
|||
|
||||
(require "crypto.rkt")
|
||||
(require "oakley-groups.rkt")
|
||||
(require "ssh-host-key.rkt")
|
||||
(require "ssh-keys.rkt")
|
||||
(require "ssh-numbers.rkt")
|
||||
(require "ssh-message-types.rkt")
|
||||
(require "ssh-exceptions.rkt")
|
||||
|
|
@ -145,7 +145,7 @@
|
|||
|
||||
;; DS ExchangeHashInfo Symbol Symbol (Bytes Bytes Symbol -> Void) -> Void
|
||||
;; Performs the server's half of the Diffie-Hellman key exchange protocol.
|
||||
(define (perform-server-key-exchange conn-ds hash-info kex-alg host-key-alg finish)
|
||||
(define (perform-server-key-exchange conn-ds hash-info kex-alg host-key-private host-key-alg finish)
|
||||
(match kex-alg
|
||||
['diffie-hellman-group14-sha256
|
||||
(define group dh:oakley-group-14)
|
||||
|
|
@ -157,15 +157,15 @@
|
|||
(define peer-key (datum->pk-key (list 'dh 'public p g e) 'rkt-public))
|
||||
(define shared-secret (pk-derive-secret private-key peer-key))
|
||||
(define hash-alg sha256)
|
||||
(define-values (host-key-private host-key-public) (host-key-algorithm->keys host-key-alg))
|
||||
(define host-key-bytes (pieces->ssh-host-key (public-key->pieces host-key-public)))
|
||||
(define host-key-public (pk-key->public-only-key host-key-private))
|
||||
(define host-key-bytes (pieces->ssh-key (public-key->pieces host-key-public)))
|
||||
(define exchange-hash (dh-exchange-hash hash-alg
|
||||
hash-info
|
||||
host-key-bytes
|
||||
e
|
||||
public-key-as-integer
|
||||
(bit-string->integer shared-secret #t #f)))
|
||||
(define h-signature (host-key-signature host-key-private host-key-alg exchange-hash))
|
||||
(define h-signature (make-key-signature host-key-private host-key-alg exchange-hash))
|
||||
(send! (outbound-packet
|
||||
(ssh-msg-kexdh-reply (bit-string->bytes host-key-bytes)
|
||||
public-key-as-integer
|
||||
|
|
@ -176,7 +176,7 @@
|
|||
|
||||
;; DS ExchangeHashInfo Symbol Symbol (Bytes Bytes Symbol -> Void) -> Void
|
||||
;; Performs the client's half of the Diffie-Hellman key exchange protocol.
|
||||
(define (perform-client-key-exchange conn-ds hash-info kex-alg host-key-alg finish)
|
||||
(define (perform-client-key-exchange conn-ds hash-info kex-alg host-key-public host-key-alg finish)
|
||||
(match kex-alg
|
||||
['diffie-hellman-group14-sha256
|
||||
(define group dh:oakley-group-14)
|
||||
|
|
@ -190,14 +190,16 @@
|
|||
(define peer-key (datum->pk-key (list 'dh 'public p g f) 'rkt-public))
|
||||
(define shared-secret (pk-derive-secret private-key peer-key))
|
||||
(define hash-alg sha256)
|
||||
(define host-public-key (pieces->public-key (ssh-host-key->pieces host-key-bytes)))
|
||||
(when (not (equal? (ssh-key->pieces host-key-bytes) (public-key->pieces host-key-public)))
|
||||
(disconnect-with-error conn-ds SSH_DISCONNECT_HOST_KEY_NOT_VERIFIABLE
|
||||
"Unexpected host key! ~v" host-key-bytes))
|
||||
(define exchange-hash (dh-exchange-hash hash-alg
|
||||
hash-info
|
||||
host-key-bytes
|
||||
public-key-as-integer
|
||||
f
|
||||
(bit-string->integer shared-secret #t #f)))
|
||||
(verify-host-key-signature! host-public-key host-key-alg exchange-hash h-signature)
|
||||
(verify-key-signature! host-key-public host-key-alg exchange-hash h-signature)
|
||||
(finish shared-secret exchange-hash hash-alg)))]
|
||||
[_ (disconnect-with-error conn-ds SSH_DISCONNECT_KEY_EXCHANGE_FAILED
|
||||
"Bad key-exchange algorithm ~v" kex-alg)]))
|
||||
|
|
@ -208,6 +210,7 @@
|
|||
#:message message
|
||||
#:rekey-state rekey-state
|
||||
#:is-server? is-server?
|
||||
#:supplied-host-key supplied-host-key
|
||||
#:local-id local-id
|
||||
#:remote-id remote-id
|
||||
#:session-id session-id
|
||||
|
|
@ -273,6 +276,7 @@
|
|||
(exchange-hash-info remote-id local-id encoded-remote-algs encoded-local-algs)
|
||||
(exchange-hash-info local-id remote-id encoded-local-algs encoded-remote-algs))
|
||||
kex-alg
|
||||
supplied-host-key
|
||||
host-key-alg
|
||||
(lambda (shared-secret exchange-hash hash-alg)
|
||||
(when (not (session-id)) (session-id exchange-hash)) ;; don't overwrite existing ID
|
||||
|
|
@ -315,48 +319,99 @@
|
|||
;; Service request manager and user authentication
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (service-request-handler conn-ds)
|
||||
(define (service-request-handler conn-ds user-public-key-accepted? session-id)
|
||||
(define-field authentication-state #f)
|
||||
(begin/dataflow (log-info "authentication-state ~s" (authentication-state)))
|
||||
|
||||
(define (acceptable-ed25519-pk key-alg user-name pk-bytes)
|
||||
(and (equal? key-alg #"ssh-ed25519")
|
||||
(let ((pk (ssh-key->pieces pk-bytes)))
|
||||
(and pk
|
||||
(user-public-key-accepted? user-name pk)
|
||||
(pieces->public-key pk)))))
|
||||
|
||||
(define (run-userauth)
|
||||
(define expected-service #"ssh-connection")
|
||||
|
||||
(define remaining-methods '(publickey password))
|
||||
(define (give-up-on method)
|
||||
(set! remaining-methods (remq method remaining-methods)))
|
||||
|
||||
(at conn-ds
|
||||
(send! (outbound-packet (ssh-msg-userauth-banner #"Welcome to Racket SSH!\r\n" #"")))
|
||||
(react
|
||||
(define (auth-ok new-authentication-state)
|
||||
(stop-current-facet
|
||||
(send! (outbound-packet (ssh-msg-userauth-success)))
|
||||
(authentication-state new-authentication-state)
|
||||
;; RFC4252 section 5.1 page 6:
|
||||
(react (with-incoming-task (SSH_MSG_USERAUTH_REQUEST _ _)))
|
||||
(spawn #:name 'channel-manager (run-channel-manager conn-ds))))
|
||||
|
||||
(with-incoming-task
|
||||
(SSH_MSG_USERAUTH_REQUEST
|
||||
_ (ssh-msg-userauth-request $user-name expected-service #"none" _))
|
||||
;; This is a request for available authentication methods.
|
||||
(send! (outbound-packet (ssh-msg-userauth-failure remaining-methods #f))))
|
||||
|
||||
(with-incoming-task
|
||||
(SSH_MSG_USERAUTH_REQUEST
|
||||
_ (ssh-msg-userauth-request $user-name expected-service #"password" $extension))
|
||||
(log-info "SSH-MSG-USERAUTH-REQUEST ~s ~s ~s ~s" user-name expected-service #"password" extension)
|
||||
(bit-string-case extension
|
||||
([ (= #f :: (t:boolean))
|
||||
(password-bytes :: (t:string #:pack)) ]
|
||||
(log-info "User supplied password ~s" password-bytes)
|
||||
(auth-ok (SshAuthenticatedUser user-name expected-service)))
|
||||
(else
|
||||
(give-up-on 'password)
|
||||
(send! (outbound-packet (ssh-msg-userauth-failure remaining-methods #f))))))
|
||||
|
||||
(with-incoming-task
|
||||
(SSH_MSG_USERAUTH_REQUEST
|
||||
_ (ssh-msg-userauth-request $user-name expected-service #"publickey" $extension))
|
||||
(log-info "SSH-MSG-USERAUTH-REQUEST ~s ~s ~s ~s" user-name expected-service #"publickey" extension)
|
||||
(bit-string-case extension
|
||||
([ (= #f :: (t:boolean))
|
||||
(key-alg :: (t:string #:pack))
|
||||
(pk-blob :: (t:string #:pack)) ]
|
||||
(if (acceptable-ed25519-pk key-alg user-name pk-blob)
|
||||
(send! (outbound-packet (ssh-msg-userauth-pk-ok key-alg pk-blob)))
|
||||
(send! (outbound-packet (ssh-msg-userauth-failure remaining-methods #f)))))
|
||||
([ (= #t :: (t:boolean))
|
||||
(key-alg :: (t:string #:pack))
|
||||
(pk-bytes :: (t:string #:pack))
|
||||
(signature :: (t:string #:pack)) ]
|
||||
(let ((pk (acceptable-ed25519-pk key-alg user-name pk-bytes)))
|
||||
(if (not pk)
|
||||
(send! (outbound-packet (ssh-msg-userauth-failure remaining-methods #f)))
|
||||
(let* ((exchange-hash
|
||||
(bit-string->bytes
|
||||
(bit-string ((session-id) :: (t:string))
|
||||
SSH_MSG_USERAUTH_REQUEST
|
||||
(user-name :: (t:string))
|
||||
(expected-service :: (t:string))
|
||||
(#"publickey" :: (t:string))
|
||||
(#t :: (t:boolean))
|
||||
(key-alg :: (t:string))
|
||||
(pk-bytes :: (t:string))))))
|
||||
(verify-key-signature! pk 'ssh-ed25519 exchange-hash signature)
|
||||
(auth-ok (SshAuthenticatedUser user-name expected-service))))))
|
||||
(else
|
||||
(give-up-on 'publickey)
|
||||
(send! (outbound-packet (ssh-msg-userauth-failure remaining-methods #f)))))))))
|
||||
|
||||
(at conn-ds
|
||||
(assert #:when (authentication-state) (authentication-state))
|
||||
|
||||
(with-incoming-task (SSH_MSG_SERVICE_REQUEST _ (ssh-msg-service-request $service))
|
||||
(match service
|
||||
[#"ssh-userauth"
|
||||
(cond
|
||||
[(authentication-state)
|
||||
(disconnect-with-error SSH_DISCONNECT_SERVICE_NOT_AVAILABLE
|
||||
"Repeated authentication is not permitted")]
|
||||
[else
|
||||
(at conn-ds
|
||||
(send! (outbound-packet (ssh-msg-service-accept service)))
|
||||
(with-incoming-task/react
|
||||
(SSH_MSG_USERAUTH_REQUEST _ (ssh-msg-userauth-request $user-name
|
||||
$service-name
|
||||
$method-name
|
||||
$extension))
|
||||
(log-info "SSH-MSG-USERAUTH-REQUEST ~s ~s ~s ~s"
|
||||
user-name
|
||||
service-name
|
||||
method-name
|
||||
extension)
|
||||
(send! (outbound-packet
|
||||
(ssh-msg-userauth-banner #"Welcome to Racket SSH!\r\n" #"")))
|
||||
(cond
|
||||
[(and (positive? (bytes-length user-name))
|
||||
(equal? service-name #"ssh-connection"))
|
||||
;; TODO: Actually implement client authentication
|
||||
(send! (outbound-packet (ssh-msg-userauth-success)))
|
||||
(authentication-state (SshAuthenticatedUser user-name service-name))
|
||||
(react
|
||||
(with-incoming-task (SSH_MSG_USERAUTH_REQUEST _ _)
|
||||
;; RFC4252 section 5.1 page 6
|
||||
))
|
||||
(spawn #:name 'channel-manager (run-channel-manager conn-ds))]
|
||||
[else
|
||||
(send! (outbound-packet (ssh-msg-userauth-failure '(none) #f)))])))])]
|
||||
(if (authentication-state)
|
||||
(disconnect-with-error SSH_DISCONNECT_SERVICE_NOT_AVAILABLE
|
||||
"Repeated authentication is not permitted")
|
||||
(begin (send! (outbound-packet (ssh-msg-service-accept service)))
|
||||
(run-userauth)))]
|
||||
[_
|
||||
(disconnect-with-error SSH_DISCONNECT_SERVICE_NOT_AVAILABLE
|
||||
"Service ~v not supported"
|
||||
|
|
@ -590,7 +645,9 @@
|
|||
ground-ds
|
||||
local-identification-string
|
||||
peer-identification-string
|
||||
session-role)
|
||||
session-role
|
||||
supplied-host-key
|
||||
user-public-key-accepted?)
|
||||
(define-field rekey-state (rekey-in-seconds-or-bytes -1 -1 0))
|
||||
(define-field session-id #f)
|
||||
(define-field total-transferred 0)
|
||||
|
|
@ -631,6 +688,7 @@
|
|||
#:message message
|
||||
#:rekey-state rekey-state
|
||||
#:is-server? (case session-role ((client) #f) ((server) #t))
|
||||
#:supplied-host-key supplied-host-key
|
||||
#:local-id local-identification-string
|
||||
#:remote-id peer-identification-string
|
||||
#:session-id session-id
|
||||
|
|
@ -640,7 +698,8 @@
|
|||
(react
|
||||
(at conn-ds
|
||||
(stop-on (message 'enable-service-request-handler)
|
||||
(spawn #:name 'service-request-handler (service-request-handler conn-ds)))))
|
||||
(spawn #:name 'service-request-handler
|
||||
(service-request-handler conn-ds user-public-key-accepted? session-id)))))
|
||||
|
||||
(define (maybe-rekey)
|
||||
(match (rekey-state)
|
||||
|
|
|
|||
Loading…
Reference in New Issue