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