Split out exceptions and related utilities
This commit is contained in:
parent
4b10f3ade1
commit
e62ef24aae
|
@ -0,0 +1,41 @@
|
|||
#lang racket/base
|
||||
;; Exceptions and error-raising and -handling utilities used in structuring SSH sessions.
|
||||
|
||||
(provide (struct-out exn:fail:contract:protocol)
|
||||
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
|
||||
;; 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)
|
||||
|
||||
;; 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))
|
||||
|
||||
;; 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))
|
||||
|
||||
;; Boolean Any Natural FormatString [Any ...] -> raised exn:fail:contract:protocol
|
||||
(define (disconnect-with-error* 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?))))
|
|
@ -9,28 +9,18 @@
|
|||
(require rackunit)
|
||||
(require "aes-ctr.rkt")
|
||||
(require "safe-io.rkt")
|
||||
(require "oakley-groups.rkt")
|
||||
|
||||
(require "host-key.rkt")
|
||||
|
||||
(require "ssh-numbers.rkt")
|
||||
(require "ssh-message-types.rkt")
|
||||
(require "oakley-groups.rkt")
|
||||
(require "host-key.rkt")
|
||||
(require "ssh-exceptions.rkt")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Data definitions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; 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
|
||||
;; 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)
|
||||
|
||||
;; A RekeyState is one of
|
||||
;; - a (rekey-wait Number Number), representing a time or
|
||||
;; transfer-amount by which rekeying should be started
|
||||
|
@ -226,21 +216,6 @@
|
|||
#f
|
||||
0)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Error signalling
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (disconnect-with-error reason-code format-string . args)
|
||||
(apply disconnect-with-error/local-info '() reason-code format-string args))
|
||||
|
||||
(define (disconnect-with-error/local-info 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
|
||||
#f))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; I/O Utilities for timeouts and decryption
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
@ -525,15 +500,13 @@
|
|||
|
||||
;; PacketHandler for handling SSH_MSG_DISCONNECT.
|
||||
(define (handle-msg-disconnect packet message conn)
|
||||
(raise (exn:fail:contract:protocol
|
||||
(format "Received SSH_MSG_DISCONNECT with reason code ~a and message ~s"
|
||||
(ssh-msg-disconnect-reason-code message)
|
||||
(bytes->string/utf-8 (bit-string->bytes
|
||||
(ssh-msg-disconnect-description message))))
|
||||
(current-continuation-marks)
|
||||
(ssh-msg-disconnect-reason-code message)
|
||||
'()
|
||||
#t)))
|
||||
(disconnect-with-error* #t
|
||||
'()
|
||||
(ssh-msg-disconnect-reason-code message)
|
||||
"Received SSH_MSG_DISCONNECT with reason code ~a and message ~s"
|
||||
(ssh-msg-disconnect-reason-code message)
|
||||
(bytes->string/utf-8 (bit-string->bytes
|
||||
(ssh-msg-disconnect-description message)))))
|
||||
|
||||
;; PacketHandler for handling SSH_MSG_IGNORE.
|
||||
(define (handle-msg-ignore packet message conn)
|
||||
|
|
Loading…
Reference in New Issue