60 lines
2.6 KiB
Racket
60 lines
2.6 KiB
Racket
#lang racket/base
|
|
;; Exceptions and error-raising and -handling utilities used in structuring SSH sessions.
|
|
;;
|
|
;;; Copyright 2010, 2011, 2012, 2013 Tony Garnock-Jones <tonyg@ccs.neu.edu>
|
|
;;;
|
|
;;; This file is part of marketplace-ssh.
|
|
;;;
|
|
;;; marketplace-ssh is free software: you can redistribute it and/or
|
|
;;; modify it under the terms of the GNU General Public License as
|
|
;;; published by the Free Software Foundation, either version 3 of the
|
|
;;; License, or (at your option) any later version.
|
|
;;;
|
|
;;; marketplace-ssh is distributed in the hope that it will be useful,
|
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;;; General Public License for more details.
|
|
;;;
|
|
;;; You should have received a copy of the GNU General Public License
|
|
;;; along with marketplace-ssh. If not, see
|
|
;;; <http://www.gnu.org/licenses/>.
|
|
|
|
(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?))))
|