forked from syndicate-lang/marketplace-ssh-2014
100 lines
3.2 KiB
Racket
100 lines
3.2 KiB
Racket
#lang racket/base
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2011-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
|
|
|
(provide (struct-out ed25519-private-key)
|
|
(struct-out ed25519-public-key)
|
|
|
|
public-key->pieces
|
|
pieces->public-key
|
|
|
|
make-key-signature
|
|
verify-key-signature!
|
|
|
|
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) #:prefab)
|
|
(struct ed25519-public-key (q) #:prefab)
|
|
|
|
(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 (make-key-signature private-key key-alg exchange-hash)
|
|
(match key-alg
|
|
[#"ssh-ed25519"
|
|
(define signature (pk-sign private-key exchange-hash))
|
|
(bit-string (#"ssh-ed25519" :: (t:string))
|
|
(signature :: (t:string)))]))
|
|
|
|
(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-key!)) (newline) (flush-output) ;; actually check the identity TOFU/POP
|
|
(match 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-key-signature! "Signature mismatch"))]))
|
|
|
|
(define (pieces->ssh-key pieces)
|
|
(match pieces
|
|
[(ed25519-public-key q)
|
|
(bit-string (#"ssh-ed25519" :: (t:string))
|
|
(q :: (t:string)))]))
|
|
|
|
(define (ssh-key->pieces key-alg blob)
|
|
(match key-alg
|
|
[#"ssh-ed25519" (bit-string-case blob
|
|
([ (= #"ssh-ed25519" :: (t:string #:pack))
|
|
(q :: (t:string #:pack)) ]
|
|
(ed25519-public-key q))
|
|
(else #f))]
|
|
[_ #f]))
|
|
|
|
;; TODO: proper store for keys
|
|
|
|
(define (load-private-key filename)
|
|
(pieces->private-key (bytes->private-key-pieces (file->bytes filename))))
|
|
|
|
(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 #"ssh-ed25519"
|
|
(base64-decode (string->bytes/utf-8 data-base64))))]
|
|
[_ (error 'load-public-key "Cannot load key in file ~s" filename)]))
|