forked from syndicate-lang/marketplace-ssh-2014
40 lines
1.8 KiB
Racket
40 lines
1.8 KiB
Racket
#lang syndicate
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2011-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
|
|
|
;;; Error-raising and -handling utilities used in structuring SSH sessions.
|
|
|
|
(provide (struct-out protocol-error)
|
|
disconnect-with-error
|
|
disconnect-with-error/local-info
|
|
disconnect-with-error*)
|
|
|
|
;; 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 protocol-error (reason-code message local-info originated-at-peer?) #:prefab)
|
|
|
|
;; 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))
|
|
|
|
;; 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))
|
|
|
|
;; DS Boolean Any Natural FormatString [Any ...] -> signalled protocol-error
|
|
(define (disconnect-with-error* ds
|
|
originated-at-peer?
|
|
local-info
|
|
reason-code
|
|
format-string
|
|
. args)
|
|
(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))
|