forked from syndicate-lang/marketplace-ssh-2014
100 lines
3.3 KiB
Racket
100 lines
3.3 KiB
Racket
#lang racket/base
|
|
;;; 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")
|
|
|
|
(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!
|
|
|
|
pieces->ssh-host-key
|
|
ssh-host-key->pieces)
|
|
|
|
(struct ed25519-private-key (q d) #:transparent)
|
|
(struct ed25519-public-key (q) #:transparent)
|
|
|
|
(define (bytes->private-key-pieces bs)
|
|
(match (bytes->ssh-private-key bs)
|
|
[(list pk-bytes sk-bytes _comment)
|
|
(ed25519-private-key pk-bytes sk-bytes)]))
|
|
|
|
(define (pieces->private-key p)
|
|
(match p
|
|
[(ed25519-private-key q d)
|
|
(datum->pk-key (list 'eddsa 'private 'ed25519 q d) 'rkt-private)]))
|
|
|
|
(define (public-key->pieces key)
|
|
(match (pk-key->datum key 'rkt-public)
|
|
[(list 'eddsa 'public 'ed25519 q)
|
|
(ed25519-public-key q)]))
|
|
|
|
(define (pieces->public-key p)
|
|
(match p
|
|
[(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
|
|
[(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)
|
|
;; 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
|
|
[(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"))]))
|
|
|
|
(define (pieces->ssh-host-key pieces)
|
|
(match pieces
|
|
[(ed25519-public-key q)
|
|
(bit-string (#"ssh-ed25519" :: (t:string))
|
|
(q :: (t:string)))]))
|
|
|
|
(define (ssh-host-key->pieces blob)
|
|
(bit-string-case blob
|
|
([ (= #"ssh-ed25519" :: (t:string #:pack))
|
|
(q :: (t:string #:pack)) ]
|
|
(ed25519-public-key q))))
|
|
|
|
;; 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))
|
|
|
|
(check-equal? (pk-key->datum (pieces->public-key (public-key->pieces host-key-ed25519-public))
|
|
'SubjectPublicKeyInfo)
|
|
(pk-key->datum host-key-ed25519-private 'SubjectPublicKeyInfo))
|