forked from syndicate-lang/marketplace-ssh-2014
First steps toward modernization and port to syndicate-rkt.
Switch from (planet vyzo/crypto) to crypto. Comment out most of the upper layers of the protocol. Switch to new syndicate/rkt. Unfortunately since I last ran this, the set of MUST-implement kex methods has changed and there's no overlap with my default SSH client :-)
This commit is contained in:
parent
5381a0b8d3
commit
3c07c96307
|
|
@ -1,66 +0,0 @@
|
|||
#lang racket/base
|
||||
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
||||
;;; SPDX-FileCopyrightText: Copyright © 2011-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||
|
||||
;;; Provide AES CTR mode, since OpenSSL's EVP support for AES CTR mode
|
||||
;;; is still ifdef'd out.
|
||||
|
||||
(provide start-aes-ctr
|
||||
aes-ctr-process!)
|
||||
|
||||
(require ffi/unsafe)
|
||||
(require ffi/unsafe/define)
|
||||
(require openssl/libcrypto)
|
||||
|
||||
(define _AES_KEY-pointer _pointer)
|
||||
|
||||
(define AES_BLOCK_SIZE 16)
|
||||
(define sizeof-AES_KEY 244) ;; TODO: figure out a good way to get this
|
||||
;; from the header file or the library
|
||||
;; itself
|
||||
|
||||
(define-ffi-definer define-crypto libcrypto
|
||||
#:default-make-fail make-not-available)
|
||||
|
||||
(define-crypto AES_set_encrypt_key (_fun _pointer _int _AES_KEY-pointer -> _int))
|
||||
;;(define-crypto AES_set_decrypt_key (_fun _pointer _int _AES_KEY-pointer -> _int))
|
||||
|
||||
(define-crypto AES_ctr128_encrypt
|
||||
(_fun _pointer ;; in
|
||||
_pointer ;; out
|
||||
_long ;; length
|
||||
_AES_KEY-pointer ;; key
|
||||
_pointer ;; ivec, AES_BLOCK_SIZE bytes
|
||||
_pointer ;; ecount_buf, AES_BLOCK_SIZE bytes
|
||||
_pointer ;; int pointer, the "num" field of the ongoing state (??)
|
||||
-> _void))
|
||||
|
||||
(struct aes-ctr-state (key ivec ecount num) #:transparent)
|
||||
|
||||
(define (start-aes-ctr key initialization-vector)
|
||||
(let ((key-buffer (malloc sizeof-AES_KEY))
|
||||
(ivec (make-bytes AES_BLOCK_SIZE))
|
||||
(ecount (make-bytes AES_BLOCK_SIZE))
|
||||
(num (make-bytes (ctype-sizeof _int))))
|
||||
(AES_set_encrypt_key key
|
||||
(* 8 (bytes-length key)) ;; measured in bits
|
||||
key-buffer)
|
||||
(bytes-copy! ivec 0 initialization-vector 0 AES_BLOCK_SIZE)
|
||||
(bytes-fill! ecount 0)
|
||||
(bytes-fill! num 0)
|
||||
(aes-ctr-state key-buffer
|
||||
ivec
|
||||
ecount
|
||||
num)))
|
||||
|
||||
(define (aes-ctr-process! state input-block)
|
||||
(define block-length (bytes-length input-block))
|
||||
(define output-block (make-bytes block-length))
|
||||
(AES_ctr128_encrypt input-block
|
||||
output-block
|
||||
block-length
|
||||
(aes-ctr-state-key state)
|
||||
(aes-ctr-state-ivec state)
|
||||
(aes-ctr-state-ecount state)
|
||||
(aes-ctr-state-num state))
|
||||
output-block)
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
#lang racket/base
|
||||
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
||||
;;; SPDX-FileCopyrightText: Copyright © 2011-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||
|
||||
(provide (all-from-out crypto))
|
||||
|
||||
(require crypto)
|
||||
(require crypto/all)
|
||||
(use-all-factories!)
|
||||
|
|
@ -1,77 +0,0 @@
|
|||
#lang racket/base
|
||||
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
||||
;;; SPDX-FileCopyrightText: Copyright © 2011-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||
|
||||
(provide make-queue
|
||||
queue?
|
||||
enqueue
|
||||
enqueue-all
|
||||
dequeue
|
||||
list->queue
|
||||
queue->list
|
||||
queue-length
|
||||
queue-empty?
|
||||
queue-append
|
||||
queue-extract)
|
||||
|
||||
(struct queue (head tail) #:transparent)
|
||||
|
||||
(define (make-queue)
|
||||
(queue '() '()))
|
||||
|
||||
(define (enqueue q v)
|
||||
(queue (queue-head q)
|
||||
(cons v (queue-tail q))))
|
||||
|
||||
(define (enqueue-all q v)
|
||||
(queue (queue-head q)
|
||||
(append (reverse v) (queue-tail q))))
|
||||
|
||||
(define (shuffle q)
|
||||
(if (null? (queue-head q))
|
||||
(queue (reverse (queue-tail q)) '())
|
||||
q))
|
||||
|
||||
(define (dequeue q)
|
||||
(let ((q1 (shuffle q)))
|
||||
(values (car (queue-head q1))
|
||||
(queue (cdr (queue-head q1)) (queue-tail q1)))))
|
||||
|
||||
(define (list->queue xs)
|
||||
(queue xs '()))
|
||||
|
||||
(define (queue->list q)
|
||||
(append (queue-head q) (reverse (queue-tail q))))
|
||||
|
||||
(define (queue-length q)
|
||||
(+ (length (queue-head q))
|
||||
(length (queue-tail q))))
|
||||
|
||||
(define (queue-empty? q)
|
||||
(and (null? (queue-head q))
|
||||
(null? (queue-tail q))))
|
||||
|
||||
(define (queue-append q1 q2)
|
||||
(queue (append (queue-head q1)
|
||||
(reverse (queue-tail q1))
|
||||
(queue-head q2))
|
||||
(queue-tail q2)))
|
||||
|
||||
(define (queue-extract q predicate [default-value #f])
|
||||
(let search-head ((head (queue-head q))
|
||||
(rejected-head-rev '()))
|
||||
(cond
|
||||
((null? head) (let search-tail ((tail (reverse (queue-tail q)))
|
||||
(rejected-tail-rev '()))
|
||||
(cond
|
||||
((null? tail) (values default-value q))
|
||||
((predicate (car tail)) (values (car tail)
|
||||
(queue (queue-head q)
|
||||
(append (reverse (cdr tail))
|
||||
rejected-tail-rev))))
|
||||
(else (search-tail (cdr tail) (cons (car tail) rejected-tail-rev))))))
|
||||
((predicate (car head)) (values (car head)
|
||||
(queue (append (reverse rejected-head-rev)
|
||||
(cdr head))
|
||||
(queue-tail q))))
|
||||
(else (search-head (cdr head) (cons (car head) rejected-head-rev))))))
|
||||
|
|
@ -9,11 +9,12 @@
|
|||
"base"
|
||||
|
||||
"bitsyntax"
|
||||
"syndicate"
|
||||
"crypto"
|
||||
"preserves"
|
||||
"syndicate"
|
||||
|
||||
))
|
||||
|
||||
;; (define build-deps '("rackunit-lib"))
|
||||
(define build-deps '("rackunit-lib"))
|
||||
|
||||
(define pre-install-collection "private/install.rkt")
|
||||
|
|
|
|||
|
|
@ -1,15 +0,0 @@
|
|||
#lang racket/base
|
||||
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
||||
;;; SPDX-FileCopyrightText: Copyright © 2013-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||
|
||||
;;; Reexport racket-matrix module contents.
|
||||
|
||||
(require marketplace/sugar)
|
||||
(require marketplace/drivers/tcp)
|
||||
(require marketplace/drivers/timer)
|
||||
(require marketplace/drivers/event-relay)
|
||||
|
||||
(provide (all-from-out marketplace/sugar))
|
||||
(provide (all-from-out marketplace/drivers/tcp))
|
||||
(provide (all-from-out marketplace/drivers/timer))
|
||||
(provide (all-from-out marketplace/drivers/event-relay))
|
||||
|
|
@ -1,12 +1,13 @@
|
|||
#lang racket/base
|
||||
#lang syndicate
|
||||
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
||||
;;; SPDX-FileCopyrightText: Copyright © 2012-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||
|
||||
;;; (Temporary) example client and server
|
||||
|
||||
(require racket/set)
|
||||
(require racket/match)
|
||||
(require racket/contract)
|
||||
(require syndicate/drivers/timer)
|
||||
(require syndicate/drivers/tcp)
|
||||
(require syndicate/dataspace)
|
||||
|
||||
(require (only-in racket/port peek-bytes-avail!-evt))
|
||||
(require "cook-port.rkt")
|
||||
(require "sandboxes.rkt")
|
||||
|
|
@ -17,19 +18,16 @@
|
|||
(require "ssh-channel.rkt")
|
||||
(require "ssh-message-types.rkt")
|
||||
(require "ssh-exceptions.rkt")
|
||||
(require "marketplace-support.rkt")
|
||||
|
||||
(define (main)
|
||||
(ground-vm (timer-driver)
|
||||
(tcp-driver)
|
||||
(tcp-spy)
|
||||
(name-process 'ssh-tcp-listener (spawn listener))))
|
||||
|
||||
(define listener
|
||||
(transition/no-state
|
||||
(observe-publishers (tcp-channel ? (tcp-listener 2322) ?)
|
||||
(match-conversation r
|
||||
(on-presence (session-vm r))))))
|
||||
(module+ main
|
||||
(actor-system/dataspace (ds)
|
||||
(spawn-timer-driver ds)
|
||||
(spawn-tcp-driver ds)
|
||||
(spawn #:name 'ssh-tcp-listener
|
||||
(at ds
|
||||
(during/spawn (Connection $conn (TcpInbound "0.0.0.0" 2322))
|
||||
#:name (list 'ssh conn)
|
||||
(session ds conn))))))
|
||||
|
||||
;;---------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -44,242 +42,164 @@
|
|||
"Invalid peer identification string ~v"
|
||||
peer-identification-string)))
|
||||
|
||||
(define (spy marker)
|
||||
(define (dump what message)
|
||||
(write `(,marker ,what ,message))
|
||||
(newline)
|
||||
(flush-output)
|
||||
(void))
|
||||
(list
|
||||
(observe-publishers/everything (wild)
|
||||
(match-interest-type i
|
||||
(match-conversation c
|
||||
(on-presence (dump 'arrived (role 'publisher c i)))
|
||||
(on-absence (dump 'departed (role 'publisher c i)))
|
||||
(on-message [message (dump 'message message)]))))
|
||||
(observe-subscribers/everything (wild)
|
||||
(match-interest-type i
|
||||
(match-conversation c
|
||||
(on-presence (dump 'arrived (role 'subscriber c i)))
|
||||
(on-absence (dump 'departed (role 'subscriber c i)))
|
||||
(on-message [message (dump 'feedback message)]))))))
|
||||
(define (session ground-ds conn)
|
||||
(define root-facet this-facet)
|
||||
|
||||
(define-syntax-rule (wait-as my-orientation topic action ...)
|
||||
(let-fresh (endpoint-name)
|
||||
(build-endpoint endpoint-name
|
||||
(role my-orientation topic 'observer)
|
||||
(match-state state
|
||||
(on-presence (sequence-actions (transition state
|
||||
(delete-endpoint endpoint-name)
|
||||
action ...)))))))
|
||||
(define update-input-handler
|
||||
(accept-connection conn
|
||||
#:initial-credit #f
|
||||
#:on-data (lambda (input mode) (error 'session "Unexpected input"))))
|
||||
|
||||
(define (session-vm new-conversation)
|
||||
(match-define (tcp-channel remote-addr local-addr _) new-conversation)
|
||||
(define local-identification #"SSH-2.0-RacketSSH_0.0")
|
||||
(define local-identification "SSH-2.0-RacketSSH_0.0")
|
||||
(send-line conn local-identification)
|
||||
|
||||
(define (issue-identification-string)
|
||||
(at-meta-level
|
||||
(send-message (tcp-channel local-addr remote-addr
|
||||
(bytes-append local-identification #"\r\n")))))
|
||||
(send-lines-credit conn 1 (LineMode-crlf))
|
||||
(update-input-handler
|
||||
#:on-data (lambda (remote-identification _mode)
|
||||
(check-remote-identification! remote-identification)
|
||||
|
||||
(define (read-handshake-and-become-reader)
|
||||
(transition 'handshake-is-stateless ;; but, crucially, the ssh-reader proper isn't!
|
||||
(at-meta-level
|
||||
(name-endpoint 'socket-reader
|
||||
(subscriber (tcp-channel remote-addr local-addr ?)
|
||||
(match-state state
|
||||
(on-message
|
||||
[(tcp-channel _ _ (? eof-object?))
|
||||
(transition state (quit))]
|
||||
[(tcp-channel _ _ (? bytes? remote-identification))
|
||||
(begin
|
||||
(check-remote-identification! remote-identification)
|
||||
(sequence-actions (transition state)
|
||||
;; First, set the incoming mode to bytes.
|
||||
(at-meta-level
|
||||
(send-feedback (tcp-channel remote-addr local-addr (tcp-mode 'bytes))))
|
||||
;; Then initialise the reader, switching to packet-reading mode.
|
||||
(lambda (ignored-state) (ssh-reader new-conversation))
|
||||
;; Finally, spawn the remaining processes and issue
|
||||
;; the initial credit to the reader.
|
||||
(name-process 'ssh-writer
|
||||
;; TODO: canary: #:exit-signal? #t
|
||||
(spawn (ssh-writer new-conversation)))
|
||||
;; Wait for the reader and writer get started, then tell
|
||||
;; the reader we are ready for a single packet and spawn
|
||||
;; the session manager.
|
||||
(wait-as 'subscriber (inbound-packet (wild) (wild) (wild) (wild))
|
||||
(wait-as 'publisher (outbound-packet (wild))
|
||||
(send-message (inbound-credit 1))
|
||||
(name-process 'ssh-session
|
||||
(spawn #:pid session-pid
|
||||
;; TODO: canary: #:exit-signal? #t
|
||||
(ssh-session session-pid
|
||||
local-identification
|
||||
remote-identification
|
||||
repl-boot
|
||||
'server)))))))])))))))
|
||||
(define session-vm
|
||||
(actor-group [(on-stop
|
||||
(stop-facet root-facet)
|
||||
(log-info "Session VM for ~a closed" conn))]
|
||||
(define conn-ds (dataspace #:name (gensym 'conn-ds)))
|
||||
|
||||
(define (exn->outbound-packet reason)
|
||||
(outbound-packet (ssh-msg-disconnect (exn:fail:contract:protocol-reason-code reason)
|
||||
(string->bytes/utf-8 (exn-message reason))
|
||||
#"")))
|
||||
(spawn/link #:name 'reader
|
||||
(ssh-reader conn-ds conn update-input-handler))
|
||||
(spawn/link #:name 'writer
|
||||
(ssh-writer conn-ds conn))
|
||||
|
||||
(define (disconnect-message-required? reason)
|
||||
(and (exn:fail:contract:protocol? reason)
|
||||
(not (exn:fail:contract:protocol-originated-at-peer? reason))))
|
||||
;; Wait for the reader and writer get started, then tell the reader
|
||||
;; we are ready for a single packet and spawn the session manager.
|
||||
(react
|
||||
(at conn-ds
|
||||
(stop-when (asserted (Observe (:pattern (inbound-credit ,_)) _))
|
||||
(send! conn-ds (inbound-credit 1))
|
||||
|
||||
(define (active-exception-handler reason)
|
||||
;; This is kind of gross: because the absence handler gets invoked
|
||||
;; several times in a row because of multiple flows intersecting
|
||||
;; this role, we have to be careful to make the transmission of
|
||||
;; the disconnection packet idempotent.
|
||||
;; TODO: this is likely no longer true now we're using exit-signals %%%
|
||||
(define interesting? (disconnect-message-required? reason))
|
||||
(transition inert-exception-handler
|
||||
(when interesting? (send-message (exn->outbound-packet reason)))
|
||||
(yield state ;; gross
|
||||
(transition state (at-meta-level (quit #f (and interesting? reason)))))))
|
||||
(spawn/link
|
||||
#:name 'session
|
||||
(ssh-session conn-ds
|
||||
ground-ds
|
||||
local-identification
|
||||
remote-identification
|
||||
(lambda (user-name)
|
||||
(error 'repl-boot "Would start session with ~a" user-name))
|
||||
'server)))))
|
||||
|
||||
(define (inert-exception-handler reason)
|
||||
inert-exception-handler)
|
||||
(at conn-ds
|
||||
(during $m
|
||||
(on-start (log-info "++ ~v" m))
|
||||
(on-stop (log-info "-- ~v" m)))
|
||||
(when (message $m)
|
||||
(log-info ">> ~v" m)))
|
||||
|
||||
(spawn-vm #:debug-name (list 'ssh-session-vm new-conversation)
|
||||
(event-relay 'ssh-event-relay)
|
||||
(timer-relay 'ssh-timer-relay)
|
||||
(spy 'SSH)
|
||||
(at conn-ds
|
||||
(when (asserted (protocol-error $reason-code $message _ $originated-at-peer?))
|
||||
(when (not originated-at-peer?)
|
||||
(send! conn-ds
|
||||
(outbound-packet (ssh-msg-disconnect reason-code
|
||||
(string->bytes/utf-8 message)
|
||||
#""))))
|
||||
(actor-system-shutdown! session-vm)))))
|
||||
|
||||
(issue-identification-string)
|
||||
|
||||
;; Expect identification string, then update (!) our inbound
|
||||
;; subscription handler to switch to packet mode.
|
||||
(at-meta-level
|
||||
(send-feedback (tcp-channel remote-addr local-addr (tcp-mode 'lines)))
|
||||
(send-feedback (tcp-channel remote-addr local-addr (tcp-credit 1))))
|
||||
|
||||
(name-process 'ssh-reader
|
||||
;; TODO: canary: #:exit-signal? #t
|
||||
(spawn (read-handshake-and-become-reader)))
|
||||
|
||||
;; TODO: canary:
|
||||
;; (spawn #:child
|
||||
;; (transition active-exception-handler
|
||||
;; (role (topic-subscriber (exit-signal (wild) (wild)))
|
||||
;; #:state current-handler
|
||||
;; #:reason reason
|
||||
;; #:on-absence (current-handler reason))))
|
||||
))
|
||||
(void))))
|
||||
|
||||
;;---------------------------------------------------------------------------
|
||||
|
||||
(define (repl-boot user-name)
|
||||
(list
|
||||
(event-relay 'app-event-relay)
|
||||
(spy 'APP)
|
||||
(at-meta-level
|
||||
(subscriber (channel-message (channel-stream-name #t (wild)) (wild))
|
||||
(match-conversation (channel-message (channel-stream-name _ cname) _)
|
||||
(on-presence (name-process cname (spawn (repl-instance user-name cname)))))))))
|
||||
;; ;; (repl-instance InputPort OutputPort InputPort OutputPort)
|
||||
;; (struct repl-instance-state (c2s-in ;; used by thread to read input from relay
|
||||
;; c2s-out ;; used by relay to feed input from remote to the thread
|
||||
;; s2c-in ;; used by relay to feed output from thread to remote
|
||||
;; s2c-out ;; used by thread to write output to relay
|
||||
;; ) #:prefab)
|
||||
|
||||
;; (repl-instance InputPort OutputPort InputPort OutputPort)
|
||||
(struct repl-instance-state (c2s-in ;; used by thread to read input from relay
|
||||
c2s-out ;; used by relay to feed input from remote to the thread
|
||||
s2c-in ;; used by relay to feed output from thread to remote
|
||||
s2c-out ;; used by thread to write output to relay
|
||||
) #:prefab)
|
||||
|
||||
(define (repl-instance user-name cname)
|
||||
(define inbound-stream (channel-stream-name #t cname))
|
||||
(define outbound-stream (channel-stream-name #f cname))
|
||||
(define (ch-do action-ctor stream body)
|
||||
(at-meta-level (action-ctor (channel-message stream body))))
|
||||
(define (handle-channel-message state body)
|
||||
(match body
|
||||
[(channel-stream-request #"pty-req" _)
|
||||
(match-define (repl-instance-state old-in _ _ old-out) state)
|
||||
(define-values (cooked-in cooked-out) (cook-io old-in old-out "> "))
|
||||
(transition (struct-copy repl-instance-state state
|
||||
[c2s-in cooked-in]
|
||||
[s2c-out cooked-out])
|
||||
(ch-do send-feedback inbound-stream (channel-stream-ok)))]
|
||||
[(channel-stream-notify #"env" _)
|
||||
;; Don't care
|
||||
(transition state)]
|
||||
[(channel-stream-request #"shell" _)
|
||||
(match-define (repl-instance-state c2s-in _ s2c-in s2c-out) state)
|
||||
(define buffer-size 1024)
|
||||
(define dummy-buffer (make-bytes buffer-size))
|
||||
(define repl-thread (thread (lambda () (repl-shell user-name c2s-in s2c-out))))
|
||||
(transition state
|
||||
(ch-do send-feedback inbound-stream (channel-stream-ok))
|
||||
(subscriber (cons (thread-dead-evt repl-thread) (wild))
|
||||
(on-message [_ (quit #f "REPL thread exited")]))
|
||||
(subscriber (cons (peek-bytes-avail!-evt dummy-buffer 0 #f s2c-in) (wild))
|
||||
;; We're using peek-bytes-avail!-evt rather than
|
||||
;; read-bytes-avail!-evt because of potential overwriting
|
||||
;; of the buffer. The overwriting can happen when there's
|
||||
;; any latency between handling the event and the next
|
||||
;; firing of the event, since the peek-bytes-avail!-evt
|
||||
;; will overwrite its buffer next time it's synced on.
|
||||
(match-state state
|
||||
(on-message
|
||||
[(cons _ (? eof-object?))
|
||||
(let ()
|
||||
(match-define (repl-instance-state c2s-in c2s-out s2c-in s2c-out) state)
|
||||
(close-input-port c2s-in)
|
||||
(close-output-port c2s-out)
|
||||
(close-input-port s2c-in)
|
||||
(close-output-port s2c-out)
|
||||
(transition state (quit)))]
|
||||
[(cons _ (? number? count))
|
||||
(transition state
|
||||
(ch-do send-message outbound-stream (channel-stream-data
|
||||
(read-bytes count s2c-in))))]))))]
|
||||
[(or (channel-stream-data #"\4") ;; C-d a.k.a EOT
|
||||
(channel-stream-eof))
|
||||
(let ()
|
||||
(close-output-port (repl-instance-state-c2s-out state))
|
||||
;; ^ this signals the repl thread to exit.
|
||||
;; Now, wait for it to do so.
|
||||
(transition state))]
|
||||
[(channel-stream-data bs)
|
||||
(write-bytes bs (repl-instance-state-c2s-out state))
|
||||
(flush-output (repl-instance-state-c2s-out state))
|
||||
(transition state
|
||||
(ch-do send-feedback inbound-stream (channel-stream-credit (bytes-length bs))))]
|
||||
[m
|
||||
(write `(channel inbound ,m)) (newline)
|
||||
(transition state)]))
|
||||
(match (channel-name-type cname)
|
||||
[#"session"
|
||||
(define-values (c2s-in c2s-out) (make-pipe))
|
||||
(define-values (s2c-in s2c-out) (make-pipe))
|
||||
(transition (repl-instance-state c2s-in c2s-out s2c-in s2c-out)
|
||||
(at-meta-level
|
||||
(subscriber (channel-message inbound-stream (wild))
|
||||
(match-state state
|
||||
(on-presence (transition state
|
||||
(ch-do send-feedback inbound-stream (channel-stream-config
|
||||
(default-packet-limit)
|
||||
#""))
|
||||
(ch-do send-feedback inbound-stream (channel-stream-credit 1024))))
|
||||
(on-message
|
||||
[(channel-message _ body)
|
||||
(handle-channel-message state body)]))))
|
||||
(at-meta-level
|
||||
(publisher (channel-message outbound-stream (wild))
|
||||
(on-message [m (begin
|
||||
(write `(channel outbound ,cname ,m)) (newline)
|
||||
(void))]))))]
|
||||
[type
|
||||
(transition/no-state
|
||||
(at-meta-level (send-message
|
||||
(channel-message outbound-stream
|
||||
(channel-stream-open-failure
|
||||
SSH_OPEN_UNKNOWN_CHANNEL_TYPE
|
||||
(bytes-append #"Unknown channel type " type))))))]))
|
||||
|
||||
;;---------------------------------------------------------------------------
|
||||
|
||||
;; TODO: module+
|
||||
(main)
|
||||
;; (define (repl-instance user-name cname)
|
||||
;; (define inbound-stream (channel-stream-name #t cname))
|
||||
;; (define outbound-stream (channel-stream-name #f cname))
|
||||
;; (define (ch-do action-ctor stream body)
|
||||
;; (at-meta-level (action-ctor (channel-message stream body))))
|
||||
;; (define (handle-channel-message state body)
|
||||
;; (match body
|
||||
;; [(channel-stream-request #"pty-req" _)
|
||||
;; (match-define (repl-instance-state old-in _ _ old-out) state)
|
||||
;; (define-values (cooked-in cooked-out) (cook-io old-in old-out "> "))
|
||||
;; (transition (struct-copy repl-instance-state state
|
||||
;; [c2s-in cooked-in]
|
||||
;; [s2c-out cooked-out])
|
||||
;; (ch-do send-feedback inbound-stream (channel-stream-ok)))]
|
||||
;; [(channel-stream-notify #"env" _)
|
||||
;; ;; Don't care
|
||||
;; (transition state)]
|
||||
;; [(channel-stream-request #"shell" _)
|
||||
;; (match-define (repl-instance-state c2s-in _ s2c-in s2c-out) state)
|
||||
;; (define buffer-size 1024)
|
||||
;; (define dummy-buffer (make-bytes buffer-size))
|
||||
;; (define repl-thread (thread (lambda () (repl-shell user-name c2s-in s2c-out))))
|
||||
;; (transition state
|
||||
;; (ch-do send-feedback inbound-stream (channel-stream-ok))
|
||||
;; (subscriber (cons (thread-dead-evt repl-thread) (wild))
|
||||
;; (on-message [_ (quit #f "REPL thread exited")]))
|
||||
;; (subscriber (cons (peek-bytes-avail!-evt dummy-buffer 0 #f s2c-in) (wild))
|
||||
;; ;; We're using peek-bytes-avail!-evt rather than
|
||||
;; ;; read-bytes-avail!-evt because of potential overwriting
|
||||
;; ;; of the buffer. The overwriting can happen when there's
|
||||
;; ;; any latency between handling the event and the next
|
||||
;; ;; firing of the event, since the peek-bytes-avail!-evt
|
||||
;; ;; will overwrite its buffer next time it's synced on.
|
||||
;; (match-state state
|
||||
;; (on-message
|
||||
;; [(cons _ (? eof-object?))
|
||||
;; (let ()
|
||||
;; (match-define (repl-instance-state c2s-in c2s-out s2c-in s2c-out) state)
|
||||
;; (close-input-port c2s-in)
|
||||
;; (close-output-port c2s-out)
|
||||
;; (close-input-port s2c-in)
|
||||
;; (close-output-port s2c-out)
|
||||
;; (transition state (quit)))]
|
||||
;; [(cons _ (? number? count))
|
||||
;; (transition state
|
||||
;; (ch-do send-message outbound-stream (channel-stream-data
|
||||
;; (read-bytes count s2c-in))))]))))]
|
||||
;; [(or (channel-stream-data #"\4") ;; C-d a.k.a EOT
|
||||
;; (channel-stream-eof))
|
||||
;; (let ()
|
||||
;; (close-output-port (repl-instance-state-c2s-out state))
|
||||
;; ;; ^ this signals the repl thread to exit.
|
||||
;; ;; Now, wait for it to do so.
|
||||
;; (transition state))]
|
||||
;; [(channel-stream-data bs)
|
||||
;; (write-bytes bs (repl-instance-state-c2s-out state))
|
||||
;; (flush-output (repl-instance-state-c2s-out state))
|
||||
;; (transition state
|
||||
;; (ch-do send-feedback inbound-stream (channel-stream-credit (bytes-length bs))))]
|
||||
;; [m
|
||||
;; (write `(channel inbound ,m)) (newline)
|
||||
;; (transition state)]))
|
||||
;; (match (channel-name-type cname)
|
||||
;; [#"session"
|
||||
;; (define-values (c2s-in c2s-out) (make-pipe))
|
||||
;; (define-values (s2c-in s2c-out) (make-pipe))
|
||||
;; (transition (repl-instance-state c2s-in c2s-out s2c-in s2c-out)
|
||||
;; (at-meta-level
|
||||
;; (subscriber (channel-message inbound-stream (wild))
|
||||
;; (match-state state
|
||||
;; (on-presence (transition state
|
||||
;; (ch-do send-feedback inbound-stream (channel-stream-config
|
||||
;; (default-packet-limit)
|
||||
;; #""))
|
||||
;; (ch-do send-feedback inbound-stream (channel-stream-credit 1024))))
|
||||
;; (on-message
|
||||
;; [(channel-message _ body)
|
||||
;; (handle-channel-message state body)]))))
|
||||
;; (at-meta-level
|
||||
;; (publisher (channel-message outbound-stream (wild))
|
||||
;; (on-message [m (begin
|
||||
;; (write `(channel outbound ,cname ,m)) (newline)
|
||||
;; (void))]))))]
|
||||
;; [type
|
||||
;; (transition/no-state
|
||||
;; (at-meta-level (send-message
|
||||
;; (channel-message outbound-stream
|
||||
;; (channel-stream-open-failure
|
||||
;; SSH_OPEN_UNKNOWN_CHANNEL_TYPE
|
||||
;; (bytes-append #"Unknown channel type " type))))))]))
|
||||
|
|
|
|||
|
|
@ -7,24 +7,24 @@
|
|||
(provide dh:oakley-group-2
|
||||
dh:oakley-group-14)
|
||||
|
||||
;;(require (planet vyzo/crypto))
|
||||
(require (planet vyzo/crypto/dh))
|
||||
(require "crypto.rkt")
|
||||
|
||||
(require (only-in net/base64 base64-decode))
|
||||
|
||||
(define dh:oakley-group-2
|
||||
(make-!dh
|
||||
1024
|
||||
(datum->pk-parameters
|
||||
(base64-decode
|
||||
#"MIGHAoGBAP//////////yQ/aoiFowjTExmKLgNwc0SkCTgiKZ8x0Agu+pjsTmyJRSgh5jjQE
|
||||
3e+VGbPNOkMbMCsKbfJfFDdP4TVtbVHCReSFtXZiXn7G9ExC6aY37WsL/1y29Aa37e44a/ta
|
||||
iZ+lrp8kEXxLH+ZJKGZR7OZTgf//////////AgEC")))
|
||||
iZ+lrp8kEXxLH+ZJKGZR7OZTgf//////////AgEC")
|
||||
'DHParameter))
|
||||
|
||||
(define dh:oakley-group-14
|
||||
(make-!dh
|
||||
2048
|
||||
(datum->pk-parameters
|
||||
(base64-decode
|
||||
#"MIIBCAKCAQEA///////////JD9qiIWjCNMTGYouA3BzRKQJOCIpnzHQCC76mOxObIlFKCHmO
|
||||
NATd75UZs806QxswKwpt8l8UN0/hNW1tUcJF5IW1dmJefsb0TELppjftawv/XLb0Brft7jhr
|
||||
+1qJn6WunyQRfEsf5kkoZlHs5Fs9wgB8uKFjvwWY2kg2HFXTmmkWP6j9JM9fg2VdI9yjrZYc
|
||||
YvNWIIVSu57VKQdwlpZtZww1Tkq8mATxdGwIyhghfDKQXkYuNs474553LBgOhgObJ4Oi7Aei
|
||||
j7XFXfBvTFLJ3ivL9pVYFxg5lUl86pVq5RXSJhiY+gUQFXKOWoqsqmj//////////wIBAg==")))
|
||||
j7XFXfBvTFLJ3ivL9pVYFxg5lUl86pVq5RXSJhiY+gUQFXKOWoqsqmj//////////wIBAg==")
|
||||
'DHParameter))
|
||||
|
|
|
|||
|
|
@ -1,44 +1,39 @@
|
|||
#lang racket/base
|
||||
#lang syndicate
|
||||
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
||||
;;; SPDX-FileCopyrightText: Copyright © 2011-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||
|
||||
;;; Exceptions and error-raising and -handling utilities used in structuring SSH sessions.
|
||||
;;; Error-raising and -handling utilities used in structuring SSH sessions.
|
||||
|
||||
(provide (struct-out exn:fail:contract:protocol)
|
||||
(provide (struct-out protocol-error)
|
||||
disconnect-with-error
|
||||
disconnect-with-error/local-info
|
||||
disconnect-with-error*)
|
||||
|
||||
;; An exn:fail:contract:protocol, when thrown by the transport (TODO:
|
||||
;; clarify scope of this behaviour) will cause a SSH_MSG_DISCONNECT to
|
||||
;; be sent to the remote party with the included reason code, using
|
||||
;; the exn-message as the description. The local-info field is useful
|
||||
;; A `protocol-error`, when asserted, will cause a SSH_MSG_DISCONNECT
|
||||
;; to be sent to the remote party with the included reason code, using
|
||||
;; `message` as the description. The `local-info` field is useful
|
||||
;; information for diagnosing problems known to the local stack that
|
||||
;; should not be transmitted to the remote party. For example, upon
|
||||
;; detection of a MAC failure, it might be useful to know the expected
|
||||
;; and actual MACs for debugging, but they should not be sent over the
|
||||
;; wire because we could be experiencing some kind of attack.
|
||||
(struct exn:fail:contract:protocol exn:fail:contract
|
||||
(reason-code local-info originated-at-peer?)
|
||||
#:transparent)
|
||||
(struct protocol-error (reason-code message local-info originated-at-peer?) #:prefab)
|
||||
|
||||
;; Natural FormatString [Any ...] -> raised exn:fail:contract:protocol
|
||||
(define (disconnect-with-error reason-code format-string . args)
|
||||
(apply disconnect-with-error* #f '() reason-code format-string args))
|
||||
;; DS Natural FormatString [Any ...] -> signalled protocol-error
|
||||
(define (disconnect-with-error ds reason-code format-string . args)
|
||||
(apply disconnect-with-error* ds #f '() reason-code format-string args))
|
||||
|
||||
;; Any Natural FormatString [Any ...] -> raised exn:fail:contract:protocol
|
||||
(define (disconnect-with-error/local-info local-info reason-code format-string . args)
|
||||
(apply disconnect-with-error* #f local-info reason-code format-string args))
|
||||
;; DS Any Natural FormatString [Any ...] -> signalled protocol-error
|
||||
(define (disconnect-with-error/local-info ds local-info reason-code format-string . args)
|
||||
(apply disconnect-with-error* ds #f local-info reason-code format-string args))
|
||||
|
||||
;; Boolean Any Natural FormatString [Any ...] -> raised exn:fail:contract:protocol
|
||||
(define (disconnect-with-error* originated-at-peer?
|
||||
;; DS Boolean Any Natural FormatString [Any ...] -> signalled protocol-error
|
||||
(define (disconnect-with-error* ds
|
||||
originated-at-peer?
|
||||
local-info
|
||||
reason-code
|
||||
format-string
|
||||
. args)
|
||||
(let ((message (apply format format-string args)))
|
||||
(raise (exn:fail:contract:protocol message
|
||||
(current-continuation-marks)
|
||||
reason-code
|
||||
local-info
|
||||
originated-at-peer?))))
|
||||
(define message (apply format format-string args))
|
||||
(spawn (at ds (assert (protocol-error reason-code message local-info originated-at-peer?))))
|
||||
(error 'protocol-error "(~a) ~a: ~v" reason-code message local-info))
|
||||
|
|
|
|||
|
|
@ -6,8 +6,8 @@
|
|||
(require racket/port)
|
||||
(require net/base64)
|
||||
|
||||
(require (planet vyzo/crypto))
|
||||
(require bitsyntax)
|
||||
(require "crypto.rkt")
|
||||
(require "asn1-ber.rkt")
|
||||
(require "ssh-message-types.rkt")
|
||||
|
||||
|
|
@ -22,7 +22,6 @@
|
|||
pieces->public-key
|
||||
|
||||
host-key-algorithm->keys
|
||||
host-key-algorithm->digest-type
|
||||
host-key-signature
|
||||
verify-host-key-signature!
|
||||
|
||||
|
|
@ -38,8 +37,8 @@
|
|||
(define (bs->n bs) (bit-string->integer bs #t #t))
|
||||
(define (n->bs n) (integer->bit-string n (* 8 (mpint-width n)) #t))
|
||||
|
||||
(define (private-key->pieces key)
|
||||
(bytes->private-key-pieces (private-key->bytes key)))
|
||||
;; (define (private-key->pieces key)
|
||||
;; (bytes->private-key-pieces (private-key->bytes key)))
|
||||
|
||||
(define (bytes->private-key-pieces bs)
|
||||
(match (asn1-ber-decode-all bs)
|
||||
|
|
@ -76,65 +75,32 @@
|
|||
|
||||
(define (pieces->private-key p)
|
||||
(match p
|
||||
((struct rsa-private-key (version n e d p q dmp1 dmq1 iqmp))
|
||||
(bytes->private-key pkey:rsa
|
||||
(asn1-ber-encode `(0 16 ((0 2 ,(n->bs version))
|
||||
(0 2 ,(n->bs n))
|
||||
(0 2 ,(n->bs e))
|
||||
(0 2 ,(n->bs d))
|
||||
(0 2 ,(n->bs p))
|
||||
(0 2 ,(n->bs q))
|
||||
(0 2 ,(n->bs dmp1))
|
||||
(0 2 ,(n->bs dmq1))
|
||||
(0 2 ,(n->bs iqmp)))))))
|
||||
((struct dsa-private-key (version p q g y x))
|
||||
(bytes->private-key pkey:dsa
|
||||
(asn1-ber-encode `(0 16 ((0 2 ,(n->bs version))
|
||||
(0 2 ,(n->bs p))
|
||||
(0 2 ,(n->bs q))
|
||||
(0 2 ,(n->bs g))
|
||||
(0 2 ,(n->bs y))
|
||||
(0 2 ,(n->bs x)))))))))
|
||||
[(struct rsa-private-key (version n e d _p _q _dmp1 _dmq1 _iqmp))
|
||||
(datum->pk-key (list 'rsa 'private n e d)
|
||||
'rkt-private)]
|
||||
[(struct dsa-private-key (version p q g y x))
|
||||
(datum->pk-key (list 'dsa 'private p q g y x)
|
||||
'rkt-private)]))
|
||||
|
||||
(define (public-key->pieces key)
|
||||
(match (asn1-ber-decode-all (public-key->bytes key))
|
||||
(`(0 16 ((0 2 ,n-bytes)
|
||||
(0 2 ,e-bytes)))
|
||||
(rsa-public-key (bs->n n-bytes)
|
||||
(bs->n e-bytes)))
|
||||
(`(0 16 ((0 2 ,public-key-bytes) ;; y
|
||||
(0 2 ,p-bytes)
|
||||
(0 2 ,q-bytes)
|
||||
(0 2 ,g-bytes)))
|
||||
(dsa-public-key (bs->n public-key-bytes)
|
||||
(bs->n p-bytes)
|
||||
(bs->n q-bytes)
|
||||
(bs->n g-bytes)))))
|
||||
(match (pk-key->datum key 'rkt-public)
|
||||
[(list 'rsa 'public n e)
|
||||
(rsa-public-key n e)]
|
||||
[(list 'dsa 'public p q g public-key-bytes)
|
||||
(dsa-public-key public-key-bytes p q g)]))
|
||||
|
||||
(define (pieces->public-key p)
|
||||
(match p
|
||||
((struct rsa-public-key (n e))
|
||||
(bytes->public-key pkey:rsa
|
||||
(asn1-ber-encode `(0 16 ((0 2 ,(n->bs n))
|
||||
(0 2 ,(n->bs e)))))))
|
||||
(datum->pk-key (list 'rsa 'public n e) 'rkt-public))
|
||||
((struct dsa-public-key (y p q g))
|
||||
(bytes->public-key pkey:dsa
|
||||
(asn1-ber-encode `(0 16 ((0 2 ,(n->bs y))
|
||||
(0 2 ,(n->bs p))
|
||||
(0 2 ,(n->bs q))
|
||||
(0 2 ,(n->bs g)))))))))
|
||||
(datum->pk-key (list 'dsa 'public p q g y) 'rkt-public))))
|
||||
|
||||
(define (host-key-algorithm->keys host-key-alg)
|
||||
(case host-key-alg
|
||||
((ssh-dss) (values host-key-dsa-private host-key-dsa-public))
|
||||
(else (error 'host-key-algorithm->keys "Unsupported host-key-alg ~v" host-key-alg))))
|
||||
|
||||
(define (host-key-algorithm->digest-type host-key-alg)
|
||||
(case host-key-alg
|
||||
((ssh-rsa) digest:sha1)
|
||||
((ssh-dss) digest:dss1)
|
||||
(else (error 'host-key-algorithm->digest-type "Unsupported host-key-alg ~v" host-key-alg))))
|
||||
|
||||
(define (host-key-signature private-key host-key-alg exchange-hash)
|
||||
(case host-key-alg
|
||||
((ssh-rsa)
|
||||
|
|
@ -142,7 +108,7 @@
|
|||
;; local-algorithm-list in ssh-transport.rkt.
|
||||
(error 'host-key-signature "ssh-rsa host key signatures unimplemented"))
|
||||
((ssh-dss)
|
||||
(match (asn1-ber-decode-all (sign private-key digest:dss1 exchange-hash))
|
||||
(match (asn1-ber-decode-all (pk-sign private-key exchange-hash))
|
||||
(`(0 16 ((0 2 ,r-bytes)
|
||||
(0 2 ,s-bytes)))
|
||||
(bit-string (#"ssh-dss" :: (t:string))
|
||||
|
|
@ -167,7 +133,7 @@
|
|||
(s :: big-endian integer bits 160) ]
|
||||
(asn1-ber-encode `(0 16 ((0 2 ,(n->bs r))
|
||||
(0 2 ,(n->bs s))))))))))
|
||||
(when (not (verify public-key digest:dss1 signature exchange-hash))
|
||||
(when (not (pk-verify public-key exchange-hash signature))
|
||||
(error 'verify-host-key-signature! "Signature mismatch")))))
|
||||
|
||||
(define (pieces->ssh-host-key pieces)
|
||||
|
|
@ -207,7 +173,8 @@
|
|||
#"")))))
|
||||
|
||||
(define host-key-dsa-private (load-private-key "test-dsa-key"))
|
||||
(define host-key-dsa-public (pkey->public-key host-key-dsa-private))
|
||||
(define host-key-dsa-public (pk-key->public-only-key host-key-dsa-private))
|
||||
|
||||
(check-equal? (public-key->bytes (pieces->public-key (public-key->pieces host-key-dsa-public)))
|
||||
(public-key->bytes host-key-dsa-private))
|
||||
(check-equal? (pk-key->datum (pieces->public-key (public-key->pieces host-key-dsa-public))
|
||||
'SubjectPublicKeyInfo)
|
||||
(pk-key->datum host-key-dsa-private 'SubjectPublicKeyInfo))
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -1,23 +1,16 @@
|
|||
#lang racket/base
|
||||
#lang syndicate
|
||||
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
||||
;;; SPDX-FileCopyrightText: Copyright © 2011-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||
|
||||
(require bitsyntax)
|
||||
(require (planet vyzo/crypto:2:3))
|
||||
|
||||
(require racket/set)
|
||||
(require racket/match)
|
||||
|
||||
(require rackunit)
|
||||
(require syndicate/drivers/tcp)
|
||||
|
||||
(require "aes-ctr.rkt")
|
||||
|
||||
(require "crypto.rkt")
|
||||
(require "ssh-numbers.rkt")
|
||||
(require "ssh-message-types.rkt")
|
||||
(require "ssh-exceptions.rkt")
|
||||
|
||||
(require "marketplace-support.rkt")
|
||||
|
||||
(provide (struct-out inbound-packet)
|
||||
(struct-out inbound-credit)
|
||||
(struct-out outbound-packet)
|
||||
|
|
@ -103,56 +96,42 @@
|
|||
0
|
||||
0))
|
||||
|
||||
(define (make-evp-cipher-entry name cipher)
|
||||
(define (make-cipher-entry name cipher-spec key-length)
|
||||
(list name
|
||||
(supported-cipher name
|
||||
(lambda (enc? key iv)
|
||||
(let ((state ((if enc? cipher-encrypt cipher-decrypt)
|
||||
cipher key iv #:padding #f)))
|
||||
(lambda (block)
|
||||
(cipher-update! state block))))
|
||||
(cipher-key-length cipher)
|
||||
(cipher-block-size cipher)
|
||||
(cipher-iv-length cipher))))
|
||||
|
||||
(define (aes-ctr-cipher-factory enc? key iv)
|
||||
(let ((state (start-aes-ctr key iv)))
|
||||
(lambda (block)
|
||||
(aes-ctr-process! state block))))
|
||||
|
||||
(define (make-aes-ctr-entry name key-length)
|
||||
(list name
|
||||
(supported-cipher name
|
||||
aes-ctr-cipher-factory
|
||||
key-length
|
||||
16
|
||||
16)))
|
||||
(lambda (input)
|
||||
((if enc? encrypt decrypt)
|
||||
cipher-spec key iv input #:pad #f)))
|
||||
key-length
|
||||
(cipher-block-size cipher-spec)
|
||||
(cipher-iv-size cipher-spec))))
|
||||
|
||||
(define supported-crypto-algorithms
|
||||
(list
|
||||
(make-aes-ctr-entry 'aes128-ctr 16)
|
||||
(make-aes-ctr-entry 'aes192-ctr 24)
|
||||
(make-aes-ctr-entry 'aes256-ctr 32)
|
||||
(make-evp-cipher-entry 'aes128-cbc cipher:aes-128-cbc)
|
||||
(make-evp-cipher-entry 'aes192-cbc cipher:aes-192-cbc)
|
||||
(make-evp-cipher-entry 'aes256-cbc cipher:aes-256-cbc)
|
||||
(make-evp-cipher-entry '3des-cbc cipher:des-ede3)
|
||||
(make-cipher-entry 'aes128-ctr '(aes ctr) 16)
|
||||
(make-cipher-entry 'aes192-ctr '(aes ctr) 24)
|
||||
(make-cipher-entry 'aes256-ctr '(aes ctr) 32)
|
||||
(make-cipher-entry 'aes128-cbc '(aes cbc) 16)
|
||||
(make-cipher-entry 'aes192-cbc '(aes cbc) 24)
|
||||
(make-cipher-entry 'aes256-cbc '(aes cbc) 32)
|
||||
(make-cipher-entry '3des-cbc '(des-ede3 cbc) 24)
|
||||
)) ;; TODO: actually test these!
|
||||
|
||||
(define (make-hmac-entry name digest key-length-or-false)
|
||||
(let* ((digest-length (digest-size digest))
|
||||
(define (make-hmac-entry name digest-spec key-length-or-false)
|
||||
(let* ((digest-length (digest-size digest-spec))
|
||||
(key-length (or key-length-or-false digest-length)))
|
||||
(list name
|
||||
(supported-hmac name
|
||||
(lambda (key)
|
||||
(lambda (blob)
|
||||
(hmac digest key blob)))
|
||||
(hmac digest-spec key blob)))
|
||||
digest-length
|
||||
key-length))))
|
||||
|
||||
(define supported-hmac-algorithms
|
||||
(list (make-hmac-entry 'hmac-md5 digest:md5 #f)
|
||||
(make-hmac-entry 'hmac-sha1 digest:sha1 #f)))
|
||||
(list (make-hmac-entry 'hmac-md5 'md5 #f)
|
||||
(make-hmac-entry 'hmac-sha1 'sha1 #f)))
|
||||
|
||||
(define supported-compression-algorithms '(none)) ;; TODO: zlib, and zlib delayed
|
||||
|
||||
|
|
@ -161,7 +140,7 @@
|
|||
(mac-names (map car supported-hmac-algorithms)))
|
||||
(make-parameter
|
||||
(lambda ()
|
||||
(ssh-msg-kexinit (random-bytes 16)
|
||||
(ssh-msg-kexinit (crypto-random-bytes 16)
|
||||
'(diffie-hellman-group14-sha1
|
||||
diffie-hellman-group1-sha1)
|
||||
'(ssh-dss) ;; TODO: offer ssh-rsa. This will
|
||||
|
|
@ -190,7 +169,7 @@
|
|||
null-hmac
|
||||
null-hmac-description))
|
||||
|
||||
(define (apply-negotiated-options nk is-outbound?)
|
||||
(define (apply-negotiated-options conn-ds nk is-outbound?)
|
||||
(match-define (new-keys is-server?
|
||||
derive-key
|
||||
c2s-enc s2c-enc
|
||||
|
|
@ -208,7 +187,8 @@
|
|||
(define cipher-description
|
||||
(cond
|
||||
((assq enc supported-crypto-algorithms) => cadr)
|
||||
(else (disconnect-with-error SSH_DISCONNECT_KEY_EXCHANGE_FAILED
|
||||
(else (disconnect-with-error conn-ds
|
||||
SSH_DISCONNECT_KEY_EXCHANGE_FAILED
|
||||
"Could not find driver for encryption algorithm ~v"
|
||||
enc))))
|
||||
(define cipher
|
||||
|
|
@ -220,7 +200,8 @@
|
|||
(define hmac-description
|
||||
(cond
|
||||
((assq mac supported-hmac-algorithms) => cadr)
|
||||
(else (disconnect-with-error SSH_DISCONNECT_KEY_EXCHANGE_FAILED
|
||||
(else (disconnect-with-error conn-ds
|
||||
SSH_DISCONNECT_KEY_EXCHANGE_FAILED
|
||||
"Could not find driver for HMAC algorithm ~v"
|
||||
mac))))
|
||||
(define hmac
|
||||
|
|
@ -240,7 +221,7 @@
|
|||
(mac (bit-string->bytes (bit-string-append (integer->bit-string sequence-number 32 #t)
|
||||
packet))))
|
||||
|
||||
(define (check-packet-length! actual-length limit block-size)
|
||||
(define (check-packet-length! conn-ds actual-length limit block-size)
|
||||
(when (> actual-length limit)
|
||||
(log-warning (format "Packet of length ~v exceeded our limit of ~v"
|
||||
actual-length
|
||||
|
|
@ -250,7 +231,8 @@
|
|||
;; exceed the packet size limit! (For example, sending a packet of
|
||||
;; length 65564 when I'm expecting a max of 65536.) So we actually
|
||||
;; enforce twice our actual limit.
|
||||
(disconnect-with-error 0 ;; TODO: better reason code?
|
||||
(disconnect-with-error conn-ds
|
||||
0 ;; TODO: better reason code?
|
||||
"Packet of length ~v is longer than packet limit ~v"
|
||||
actual-length
|
||||
limit))
|
||||
|
|
@ -259,7 +241,8 @@
|
|||
;; the length-of-length, but the requirements for transmitted
|
||||
;; chunks of data are that they be block-size multiples
|
||||
;; *including* the length-of-length
|
||||
(disconnect-with-error SSH_DISCONNECT_PROTOCOL_ERROR
|
||||
(disconnect-with-error conn-ds
|
||||
SSH_DISCONNECT_PROTOCOL_ERROR
|
||||
"Packet of length ~v is not a multiple of block size ~v"
|
||||
actual-length
|
||||
block-size)))
|
||||
|
|
@ -279,190 +262,125 @@
|
|||
;; Encrypted Packet Input
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(struct ssh-reader-state (mode config sequence-number remaining-credit) #:prefab)
|
||||
|
||||
(define (ssh-reader new-conversation)
|
||||
(match-define (tcp-channel remote-addr local-addr _) new-conversation)
|
||||
(define (ssh-reader conn-ds conn update-input-handler)
|
||||
(define packet-size-limit (default-packet-limit))
|
||||
(define sequence-number 0)
|
||||
(define remaining-credit 0)
|
||||
|
||||
(define (issue-credit state)
|
||||
(match-define (ssh-reader-state _ (crypto-configuration _ desc _ _) _ message-credit) state)
|
||||
(when (positive? message-credit)
|
||||
(at-meta-level
|
||||
(send-feedback (tcp-channel remote-addr local-addr
|
||||
(tcp-credit (supported-cipher-block-size desc)))))))
|
||||
(define config initial-crypto-configuration)
|
||||
|
||||
(transition (ssh-reader-state 'packet-header initial-crypto-configuration 0 0)
|
||||
(at-meta-level
|
||||
(name-endpoint 'socket-reader
|
||||
(subscriber (tcp-channel remote-addr local-addr ?)
|
||||
(match-state (and state
|
||||
(ssh-reader-state mode
|
||||
(crypto-configuration cipher
|
||||
cipher-description
|
||||
hmac
|
||||
hmac-description)
|
||||
sequence-number
|
||||
remaining-credit))
|
||||
(on-message
|
||||
[(tcp-channel _ _ (? eof-object?))
|
||||
(transition state (quit))]
|
||||
[(tcp-channel _ _ (? bytes? encrypted-packet))
|
||||
(let ()
|
||||
(define block-size (supported-cipher-block-size cipher-description))
|
||||
(define first-block-size block-size)
|
||||
(define subsequent-block-size (if cipher block-size 1))
|
||||
(define decryptor (if cipher cipher values))
|
||||
(define (current-cipher) (crypto-configuration-cipher config))
|
||||
(define (block-size)
|
||||
(supported-cipher-block-size (crypto-configuration-cipher-description config)))
|
||||
(define (decrypt-chunk chunk) ((or (current-cipher) values) chunk))
|
||||
(define (subsequent-block-size) (if (current-cipher) (block-size) 1))
|
||||
(define (hmac) (crypto-configuration-hmac config))
|
||||
|
||||
(define (check-hmac packet-length payload-length packet)
|
||||
(define computed-hmac-bytes (apply-hmac hmac sequence-number packet))
|
||||
(define mac-byte-count (bytes-length computed-hmac-bytes))
|
||||
(if (positive? mac-byte-count)
|
||||
(transition (struct-copy ssh-reader-state state
|
||||
[mode `(packet-hmac ,computed-hmac-bytes
|
||||
,mac-byte-count
|
||||
,packet-length
|
||||
,payload-length
|
||||
,packet)])
|
||||
(at-meta-level
|
||||
(send-feedback (tcp-channel remote-addr local-addr
|
||||
(tcp-credit mac-byte-count)))))
|
||||
(finish-packet 0 packet-length payload-length packet)))
|
||||
(define (issue-credit)
|
||||
(when (positive? remaining-credit)
|
||||
(send-bytes-credit conn (block-size))))
|
||||
|
||||
(define (finish-packet mac-byte-count packet-length payload-length packet)
|
||||
(define bytes-read (+ packet-length mac-byte-count))
|
||||
(define payload (subbytes packet 5 (+ 5 payload-length)))
|
||||
(define new-credit (- remaining-credit 1))
|
||||
(define new-state (struct-copy ssh-reader-state state
|
||||
[mode 'packet-header]
|
||||
[sequence-number (+ sequence-number 1)]
|
||||
[remaining-credit new-credit]))
|
||||
(transition new-state
|
||||
(issue-credit new-state)
|
||||
(send-message
|
||||
(inbound-packet sequence-number
|
||||
payload
|
||||
(ssh-message-decode payload)
|
||||
bytes-read))))
|
||||
(define (handle-packet-header encrypted-packet _mode)
|
||||
(define first-block (decrypt-chunk encrypted-packet))
|
||||
(define packet-length (integer-bytes->integer first-block #f #t 0 4))
|
||||
(check-packet-length! conn-ds packet-length packet-size-limit (subsequent-block-size))
|
||||
(define padding-length (bytes-ref first-block 4))
|
||||
(define payload-length (- packet-length padding-length 1))
|
||||
(define amount-of-packet-in-first-block (- (bytes-length first-block) 4)) ;; not incl length
|
||||
(define remaining-to-read (- packet-length amount-of-packet-in-first-block))
|
||||
(if (positive? remaining-to-read)
|
||||
(begin
|
||||
(send-bytes-credit conn remaining-to-read)
|
||||
(update-input-handler
|
||||
#:on-data (lambda (encrypted-packet _mode)
|
||||
(check-hmac packet-length
|
||||
payload-length
|
||||
(bytes-append first-block (decrypt-chunk encrypted-packet))))))
|
||||
(check-hmac packet-length payload-length first-block)))
|
||||
|
||||
(match mode
|
||||
['packet-header
|
||||
(define decrypted-packet (decryptor encrypted-packet))
|
||||
(define first-block decrypted-packet)
|
||||
(define packet-length (integer-bytes->integer first-block #f #t 0 4))
|
||||
(check-packet-length! packet-length packet-size-limit subsequent-block-size)
|
||||
(define padding-length (bytes-ref first-block 4))
|
||||
(define payload-length (- packet-length padding-length 1))
|
||||
(define amount-of-packet-in-first-block
|
||||
(- (bytes-length first-block) 4)) ;; not incl length
|
||||
(define remaining-to-read (- packet-length amount-of-packet-in-first-block))
|
||||
(define (check-hmac packet-length payload-length packet)
|
||||
(define computed-hmac-bytes (apply-hmac (hmac) sequence-number packet))
|
||||
(define mac-byte-count (bytes-length computed-hmac-bytes))
|
||||
(if (positive? mac-byte-count)
|
||||
(begin
|
||||
(send-bytes-credit conn mac-byte-count)
|
||||
(update-input-handler
|
||||
#:on-data (lambda (received-hmac-bytes _mode)
|
||||
(if (equal? computed-hmac-bytes received-hmac-bytes)
|
||||
(finish-packet mac-byte-count packet-length payload-length packet)
|
||||
(disconnect-with-error/local-info conn-ds
|
||||
`((expected-hmac ,computed-hmac-bytes)
|
||||
(actual-hmac ,received-hmac-bytes))
|
||||
SSH_DISCONNECT_MAC_ERROR
|
||||
"Corrupt MAC")))))
|
||||
(finish-packet 0 packet-length payload-length packet)))
|
||||
|
||||
(if (positive? remaining-to-read)
|
||||
(transition (struct-copy ssh-reader-state state
|
||||
[mode `(packet-body ,packet-length
|
||||
,payload-length
|
||||
,first-block)])
|
||||
(at-meta-level
|
||||
(send-feedback (tcp-channel remote-addr local-addr
|
||||
(tcp-credit remaining-to-read)))))
|
||||
(check-hmac packet-length payload-length first-block))]
|
||||
(define (finish-packet mac-byte-count packet-length payload-length packet)
|
||||
(define bytes-read (+ packet-length mac-byte-count))
|
||||
(define payload (subbytes packet 5 (+ 5 payload-length)))
|
||||
(update-input-handler #:on-data handle-packet-header)
|
||||
(send! conn-ds (inbound-packet sequence-number
|
||||
payload
|
||||
(ssh-message-decode payload)
|
||||
bytes-read))
|
||||
(set! sequence-number (+ sequence-number 1))
|
||||
(set! remaining-credit (- remaining-credit 1))
|
||||
(issue-credit))
|
||||
|
||||
[`(packet-body ,packet-length ,payload-length ,first-block)
|
||||
(define decrypted-packet (decryptor encrypted-packet))
|
||||
(check-hmac packet-length payload-length (bytes-append first-block
|
||||
decrypted-packet))]
|
||||
(update-input-handler
|
||||
#:on-eof (lambda () (stop-current-facet))
|
||||
#:on-data handle-packet-header)
|
||||
|
||||
[`(packet-hmac ,computed-hmac-bytes
|
||||
,mac-byte-count
|
||||
,packet-length
|
||||
,payload-length
|
||||
,main-packet)
|
||||
(define received-hmac-bytes encrypted-packet) ;; not really encrypted!
|
||||
(if (equal? computed-hmac-bytes received-hmac-bytes)
|
||||
(finish-packet mac-byte-count packet-length payload-length main-packet)
|
||||
(disconnect-with-error/local-info `((expected-hmac ,computed-hmac-bytes)
|
||||
(actual-hmac ,received-hmac-bytes))
|
||||
SSH_DISCONNECT_MAC_ERROR
|
||||
"Corrupt MAC"))]))])))))
|
||||
(subscriber (inbound-credit (wild))
|
||||
(match-state state
|
||||
(on-message
|
||||
[(inbound-credit amount)
|
||||
(let ()
|
||||
(define new-state (struct-copy ssh-reader-state state
|
||||
[remaining-credit
|
||||
(+ amount (ssh-reader-state-remaining-credit state))]))
|
||||
(transition new-state
|
||||
(issue-credit new-state)))])))
|
||||
(subscriber (new-keys (wild)
|
||||
(wild)
|
||||
(wild) (wild)
|
||||
(wild) (wild)
|
||||
(wild) (wild))
|
||||
(match-state state
|
||||
(on-message
|
||||
[(? new-keys? nk)
|
||||
(transition (struct-copy ssh-reader-state state
|
||||
[config (apply-negotiated-options nk #f)]))])))
|
||||
(publisher (inbound-packet (wild) (wild) (wild) (wild)))))
|
||||
(at conn-ds
|
||||
(when (message (inbound-credit $amount))
|
||||
(set! remaining-credit (+ remaining-credit amount))
|
||||
(issue-credit))
|
||||
|
||||
(when (message ($ nk (new-keys _ _ _ _ _ _ _ _)))
|
||||
(set! config (apply-negotiated-options conn-ds nk #f)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Encrypted Packet Output
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(struct ssh-writer-state (config sequence-number) #:prefab)
|
||||
;; (struct ssh-writer-state (config sequence-number) #:prefab)
|
||||
|
||||
(define (ssh-writer new-conversation)
|
||||
(match-define (tcp-channel remote-addr local-addr _) new-conversation)
|
||||
(transition (ssh-writer-state initial-crypto-configuration 0)
|
||||
(publisher (outbound-byte-credit (wild)))
|
||||
(subscriber (outbound-packet (wild))
|
||||
(match-state (and state
|
||||
(ssh-writer-state (crypto-configuration cipher
|
||||
cipher-description
|
||||
hmac
|
||||
hmac-description)
|
||||
sequence-number))
|
||||
(on-message
|
||||
[(outbound-packet message)
|
||||
(let ()
|
||||
(define pad-block-size (supported-cipher-block-size cipher-description))
|
||||
(define encryptor (if cipher cipher values))
|
||||
(define payload (ssh-message-encode message))
|
||||
;; There must be at least 4 bytes of padding, and padding needs to
|
||||
;; make the packet length a multiple of pad-block-size.
|
||||
(define unpadded-length (+ 4 ;; length of length
|
||||
1 ;; length of length-of-padding indicator
|
||||
(bit-string-byte-count payload)))
|
||||
(define min-padded-length (+ unpadded-length 4))
|
||||
(define padded-length (round-up min-padded-length pad-block-size))
|
||||
(define padding-length (- padded-length unpadded-length))
|
||||
(define packet-length (- padded-length 4))
|
||||
;; ^^ the packet length does *not* include itself!
|
||||
(define packet (bit-string->bytes
|
||||
(bit-string (packet-length :: integer bits 32)
|
||||
(padding-length :: integer bits 8)
|
||||
(payload :: binary)
|
||||
((random-bytes padding-length) :: binary))))
|
||||
(define encrypted-packet (encryptor packet))
|
||||
(define computed-hmac-bytes (apply-hmac hmac sequence-number packet))
|
||||
(define mac-byte-count (bytes-length computed-hmac-bytes))
|
||||
(transition (struct-copy ssh-writer-state state
|
||||
[sequence-number (+ sequence-number 1)])
|
||||
(at-meta-level
|
||||
(send-message (tcp-channel local-addr remote-addr encrypted-packet)))
|
||||
(when (positive? mac-byte-count)
|
||||
(at-meta-level
|
||||
(send-message (tcp-channel local-addr remote-addr computed-hmac-bytes))))
|
||||
(send-message
|
||||
(outbound-byte-credit (+ (bytes-length encrypted-packet) mac-byte-count)))))])))
|
||||
(subscriber (new-keys (wild)
|
||||
(wild)
|
||||
(wild) (wild)
|
||||
(wild) (wild)
|
||||
(wild) (wild))
|
||||
(match-state state
|
||||
(on-message
|
||||
[(? new-keys? nk)
|
||||
(transition
|
||||
(struct-copy ssh-writer-state state [config (apply-negotiated-options nk #t)]))])))))
|
||||
(define (ssh-writer conn-ds conn)
|
||||
(define config initial-crypto-configuration)
|
||||
(define sequence-number 0)
|
||||
|
||||
(define (block-size)
|
||||
(supported-cipher-block-size (crypto-configuration-cipher-description config)))
|
||||
(define (encrypt-chunk chunk) ((or (crypto-configuration-cipher config) values) chunk))
|
||||
(define (hmac) (crypto-configuration-hmac config))
|
||||
|
||||
(at conn-ds
|
||||
(when (message (outbound-packet $message))
|
||||
(define pad-block-size (block-size))
|
||||
(define payload (ssh-message-encode message))
|
||||
;; There must be at least 4 bytes of padding, and padding needs to
|
||||
;; make the packet length a multiple of pad-block-size.
|
||||
(define unpadded-length (+ 4 ;; length of length
|
||||
1 ;; length of length-of-padding indicator
|
||||
(bit-string-byte-count payload)))
|
||||
(define min-padded-length (+ unpadded-length 4))
|
||||
(define padded-length (round-up min-padded-length pad-block-size))
|
||||
(define padding-length (- padded-length unpadded-length))
|
||||
(define packet-length (- padded-length 4))
|
||||
;; ^^ the packet length does *not* include itself!
|
||||
(define packet (bit-string->bytes
|
||||
(bit-string (packet-length :: integer bits 32)
|
||||
(padding-length :: integer bits 8)
|
||||
(payload :: binary)
|
||||
((crypto-random-bytes padding-length) :: binary))))
|
||||
(define encrypted-packet (encrypt-chunk packet))
|
||||
(define computed-hmac-bytes (apply-hmac (hmac) sequence-number packet))
|
||||
(define mac-byte-count (bytes-length computed-hmac-bytes))
|
||||
(send-data conn encrypted-packet)
|
||||
(send-data conn computed-hmac-bytes)
|
||||
(send! conn-ds (outbound-byte-credit (+ (bytes-length encrypted-packet)
|
||||
(bytes-length computed-hmac-bytes))))
|
||||
(set! sequence-number (+ sequence-number 1)))
|
||||
|
||||
(when (message ($ nk (new-keys _ _ _ _ _ _ _ _)))
|
||||
(set! config (apply-negotiated-options conn-ds nk #t)))))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,12 @@
|
|||
-----BEGIN DSA PRIVATE KEY-----
|
||||
MIIBuwIBAAKBgQCEQ1YvOR7/MQByCPJt/FSO7NN7YO1VLqy7A95M07q6AaG5FZ2A
|
||||
m9s8KZPlNFPrNhG8pRxxHhWgfBczoIObZi2saXeXQyTCUtHUejQBk+Xl31I+0SYU
|
||||
/m5fIP3Q9UY3cR8LucsIQkJIcuLVpoMmtFA/EtxYs+roxm+wtMlgk/8HkQIVAObN
|
||||
DEIjvgKwW9MKzRz8VXms/aDDAoGAeMnKQxj/iBSfQ3Wsd4ipCi3PdoLJ0+TJuiFG
|
||||
0tmbxLxwC0YCR24YMeobva/SpSu6y48+2rjv9Wc9ZKwISbrdO6xrNgDJtoCZLGK+
|
||||
C2DHEC3rBYFicOgpoysk/HsS/to3GtMnPyA2NJDR/cjUdgWBRg+4eAx1ZsVPjaJT
|
||||
A5Z60tECgYAkhzk5oi/b3zxPEPoFYki2apR4mciJso/1mYvb6fpd+rzlihNrkFAA
|
||||
LL+6uOofkyf32FIQhEN+JXDNMfaHreJkLPxGXIJ4FyUbrrZcxbmgJdh9NHd0L/mI
|
||||
yIHlo+SImp1DLCEtRP1GwKv8Lm0/rFNpY/z5Os3qeXKw1swDvEMfywIVANtH4mhn
|
||||
F6JfX/4/cJ4cpGlcgrWe
|
||||
-----END DSA PRIVATE KEY-----
|
||||
|
|
@ -1,138 +0,0 @@
|
|||
#lang racket/base
|
||||
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
||||
;;; SPDX-FileCopyrightText: Copyright © 2011-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||
|
||||
(require "../aes-ctr.rkt")
|
||||
(require rackunit)
|
||||
(require bitsyntax)
|
||||
|
||||
(check-equal? (let ((x (start-aes-ctr (make-bytes 16 97) (make-bytes 16 0))))
|
||||
(aes-ctr-process! x #"abcdefghijklmnop"))
|
||||
#"\275XO-\317^<d\16(\262\257Fv}e" ;; = bd584f2dcf5e3c640e28b2af46767d65
|
||||
)
|
||||
|
||||
(check-equal? (let ((x (start-aes-ctr (make-bytes 16 97) (make-bytes 16 0))))
|
||||
(let* ((b1 (aes-ctr-process! x #"abcdef"))
|
||||
(b2 (aes-ctr-process! x #"ghijklmnop")))
|
||||
(list b1 b2)))
|
||||
(list #"\275XO-\317^"
|
||||
#"<d\16(\262\257Fv}e"))
|
||||
|
||||
(check-equal? (let ((x (start-aes-ctr (make-bytes 16 97) (make-bytes 16 0))))
|
||||
(aes-ctr-process! x #"\275XO-\317^<d\16(\262\257Fv}e"))
|
||||
#"abcdefghijklmnop")
|
||||
|
||||
(check-equal? (let ((x (start-aes-ctr (make-bytes 16 97) (make-bytes 16 0))))
|
||||
(let* ((b1 (aes-ctr-process! x #"\275XO-\317^"))
|
||||
(b2 (aes-ctr-process! x #"<d\16(\262\257Fv}e")))
|
||||
(list b1 b2)))
|
||||
(list #"abcdef"
|
||||
#"ghijklmnop"))
|
||||
|
||||
(check-equal? (let ((x (start-aes-ctr (make-bytes 16 97) (make-bytes 16 0))))
|
||||
(aes-ctr-process! x #"abcdefghijklmnopabcdefghijklmnop"))
|
||||
#"\275XO-\317^<d\16(\262\257Fv}e!v\301\23\6@\330\305\314c\27\374\276\330 \342")
|
||||
|
||||
(check-equal? (let ((x (start-aes-ctr (make-bytes 16 97) (make-bytes 16 0))))
|
||||
(aes-ctr-process! x
|
||||
#"\275XO-\317^<d\16(\262\257Fv}e!v\301\23\6@\330\305\314c\27\374\276\330 \342"))
|
||||
#"abcdefghijklmnopabcdefghijklmnop")
|
||||
|
||||
;; Test vectors from http://tools.ietf.org/html/draft-ietf-ipsec-ciph-aes-ctr-05
|
||||
|
||||
(define (hex-string->bytes str) ;; grumble
|
||||
(define cleaned (regexp-replace* #rx"[^0-9a-fA-F]+" str ""))
|
||||
(define bits (* (string-length cleaned) 4))
|
||||
(define n (string->number cleaned 16))
|
||||
(integer->bit-string n bits #t))
|
||||
|
||||
(define (test-enc description key ivec plaintext ciphertext)
|
||||
(let ((state (start-aes-ctr (hex-string->bytes key)
|
||||
(hex-string->bytes ivec))))
|
||||
(check-equal? (aes-ctr-process! state (hex-string->bytes plaintext))
|
||||
(hex-string->bytes ciphertext)
|
||||
(format "test-enc ~v" description))))
|
||||
|
||||
;; Test Vector #1: Encrypting 16 octets using AES-CTR with 128-bit key
|
||||
(test-enc 1
|
||||
"AE 68 52 F8 12 10 67 CC 4B F7 A5 76 55 77 F3 9E"
|
||||
"00 00 00 30 00 00 00 00 00 00 00 00 00 00 00 01"
|
||||
"53 69 6E 67 6C 65 20 62 6C 6F 63 6B 20 6D 73 67"
|
||||
"E4 09 5D 4F B7 A7 B3 79 2D 61 75 A3 26 13 11 B8")
|
||||
|
||||
;; Test Vector #2: Encrypting 32 octets using AES-CTR with 128-bit key
|
||||
(test-enc 2
|
||||
"7E 24 06 78 17 FA E0 D7 43 D6 CE 1F 32 53 91 63"
|
||||
"00 6C B6 DB C0 54 3B 59 DA 48 D9 0B 00 00 00 01"
|
||||
(string-append "00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F"
|
||||
"10 11 12 13 14 15 16 17 18 19 1A 1B 1C 1D 1E 1F")
|
||||
(string-append "51 04 A1 06 16 8A 72 D9 79 0D 41 EE 8E DA D3 88"
|
||||
"EB 2E 1E FC 46 DA 57 C8 FC E6 30 DF 91 41 BE 28"))
|
||||
|
||||
;; Test Vector #3: Encrypting 36 octets using AES-CTR with 128-bit key
|
||||
(test-enc 3
|
||||
"76 91 BE 03 5E 50 20 A8 AC 6E 61 85 29 F9 A0 DC"
|
||||
"00 E0 01 7B 27 77 7F 3F 4A 17 86 F0 00 00 00 01"
|
||||
(string-append "00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F"
|
||||
"10 11 12 13 14 15 16 17 18 19 1A 1B 1C 1D 1E 1F"
|
||||
"20 21 22 23")
|
||||
(string-append "C1 CF 48 A8 9F 2F FD D9 CF 46 52 E9 EF DB 72 D7"
|
||||
"45 40 A4 2B DE 6D 78 36 D5 9A 5C EA AE F3 10 53"
|
||||
"25 B2 07 2F"))
|
||||
|
||||
;; Test Vector #4: Encrypting 16 octets using AES-CTR with 192-bit key
|
||||
(test-enc 4
|
||||
"16 AF 5B 14 5F C9 F5 79 C1 75 F9 3E 3B FB 0E ED 86 3D 06 CC FD B7 85 15"
|
||||
"00 00 00 48 36 73 3C 14 7D 6D 93 CB 00 00 00 01"
|
||||
"53 69 6E 67 6C 65 20 62 6C 6F 63 6B 20 6D 73 67"
|
||||
"4B 55 38 4F E2 59 C9 C8 4E 79 35 A0 03 CB E9 28")
|
||||
|
||||
;; Test Vector #5: Encrypting 32 octets using AES-CTR with 192-bit key
|
||||
(test-enc 5
|
||||
"7C 5C B2 40 1B 3D C3 3C 19 E7 34 08 19 E0 F6 9C 67 8C 3D B8 E6 F6 A9 1A"
|
||||
"00 96 B0 3B 02 0C 6E AD C2 CB 50 0D 00 00 00 01"
|
||||
(string-append "00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F"
|
||||
"10 11 12 13 14 15 16 17 18 19 1A 1B 1C 1D 1E 1F")
|
||||
(string-append "45 32 43 FC 60 9B 23 32 7E DF AA FA 71 31 CD 9F"
|
||||
"84 90 70 1C 5A D4 A7 9C FC 1F E0 FF 42 F4 FB 00"))
|
||||
|
||||
;; Test Vector #6: Encrypting 36 octets using AES-CTR with 192-bit key
|
||||
(test-enc 6
|
||||
"02 BF 39 1E E8 EC B1 59 B9 59 61 7B 09 65 27 9B F5 9B 60 A7 86 D3 E0 FE"
|
||||
"00 07 BD FD 5C BD 60 27 8D CC 09 12 00 00 00 01"
|
||||
(string-append "00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F"
|
||||
"10 11 12 13 14 15 16 17 18 19 1A 1B 1C 1D 1E 1F"
|
||||
"20 21 22 23")
|
||||
(string-append "96 89 3F C5 5E 5C 72 2F 54 0B 7D D1 DD F7 E7 58"
|
||||
"D2 88 BC 95 C6 91 65 88 45 36 C8 11 66 2F 21 88"
|
||||
"AB EE 09 35"))
|
||||
|
||||
;; Test Vector #7: Encrypting 16 octets using AES-CTR with 256-bit key
|
||||
(test-enc 7
|
||||
(string-append "77 6B EF F2 85 1D B0 6F 4C 8A 05 42 C8 69 6F 6C"
|
||||
"6A 81 AF 1E EC 96 B4 D3 7F C1 D6 89 E6 C1 C1 04")
|
||||
"00 00 00 60 DB 56 72 C9 7A A8 F0 B2 00 00 00 01"
|
||||
"53 69 6E 67 6C 65 20 62 6C 6F 63 6B 20 6D 73 67"
|
||||
"14 5A D0 1D BF 82 4E C7 56 08 63 DC 71 E3 E0 C0")
|
||||
|
||||
;; Test Vector #8: Encrypting 32 octets using AES-CTR with 256-bit key
|
||||
(test-enc 8
|
||||
(string-append "F6 D6 6D 6B D5 2D 59 BB 07 96 36 58 79 EF F8 86"
|
||||
"C6 6D D5 1A 5B 6A 99 74 4B 50 59 0C 87 A2 38 84")
|
||||
"00 FA AC 24 C1 58 5E F1 5A 43 D8 75 00 00 00 01"
|
||||
(string-append "00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F"
|
||||
"10 11 12 13 14 15 16 17 18 19 1A 1B 1C 1D 1E 1F")
|
||||
(string-append "F0 5E 23 1B 38 94 61 2C 49 EE 00 0B 80 4E B2 A9"
|
||||
"B8 30 6B 50 8F 83 9D 6A 55 30 83 1D 93 44 AF 1C"))
|
||||
|
||||
;; Test Vector #9: Encrypting 36 octets using AES-CTR with 256-bit key
|
||||
(test-enc 9
|
||||
(string-append "FF 7A 61 7C E6 91 48 E4 F1 72 6E 2F 43 58 1D E2"
|
||||
"AA 62 D9 F8 05 53 2E DF F1 EE D6 87 FB 54 15 3D")
|
||||
"00 1C C5 B7 51 A5 1D 70 A1 C1 11 48 00 00 00 01"
|
||||
(string-append "00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F"
|
||||
"10 11 12 13 14 15 16 17 18 19 1A 1B 1C 1D 1E 1F"
|
||||
"20 21 22 23")
|
||||
(string-append "EB 6C 52 82 1D 0B BB F7 CE 75 94 46 2A CA 4F AA"
|
||||
"B4 07 DF 86 65 69 FD 07 F4 8C C0 B5 83 D6 07 1F"
|
||||
"1E C0 E6 B8"))
|
||||
Loading…
Reference in New Issue