Split out exceptions and related utilities

This commit is contained in:
Tony Garnock-Jones 2011-10-22 09:56:10 -04:00
parent 4b10f3ade1
commit e62ef24aae
2 changed files with 53 additions and 39 deletions

41
ssh-exceptions.rkt Normal file
View File

@ -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?))))

View File

@ -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)