Honour restrictions in RFC4253 section 7.1.

ssh-session.rkt

@@ -133,6 +133,29 @@
 				  message
 				  (set-handlers conn packet-type-number #f)))))
 
+(define (dispatch-packet seq packet message conn)
+  (define packet-type-number (encoded-packet-msg-type packet))
+  (if (and (not (rekey-wait? (connection-rekey-state conn)))
+	   (or (not (ssh-msg-type-transport-layer? packet-type-number))
+	       (= packet-type-number SSH_MSG_SERVICE_REQUEST)
+	       (= packet-type-number SSH_MSG_SERVICE_ACCEPT)))
+      ;; We're in the middle of some phase of an active key-exchange,
+      ;; and received a packet that's for a higher layer than the
+      ;; transport layer, or one of the forbidden types given at the
+      ;; send of RFC4253 section 7.1.
+      (disconnect-with-error SSH_DISCONNECT_PROTOCOL_ERROR
+			     "Packets of type ~v forbidden while in key-exchange"
+			     packet-type-number)
+      ;; We're either idling, or it's a permitted packet type while
+      ;; performing key exchange. Look it up in the dispatch table.
+      (let ((handler (hash-ref (connection-dispatch-table conn)
+			       packet-type-number
+			       #f)))
+	(if handler
+	    (handler packet message conn)
+	    (begin (write-message! (ssh-msg-unimplemented seq) conn)
+		   conn)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Handlers for core transport packet types
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -406,7 +429,6 @@
 				      (rekey-volume)
 				      (connection-total-transferred conn))]))))
 
-
   (if should-discard-first-kex-packet
       (struct-copy connection (continue-after-discard conn) [discard-next-packet? #t])
       (continue-after-discard conn)))
@@ -471,16 +493,7 @@
 				transferred-count
 				(if (connection-discard-next-packet? conn)
 				    (struct-copy connection conn [discard-next-packet? #f])
-				    (let* ((packet-type-number (encoded-packet-msg-type packet))
-					   (packet-handler (hash-ref
-							    (connection-dispatch-table conn)
-							    packet-type-number
-							    #f)))
-				      (if packet-handler
-					  (packet-handler packet message conn)
-					  (begin
-					    (write-message! (ssh-msg-unimplemented seq) conn)
-					    conn)))))))))
+				    (dispatch-packet seq packet message conn)))))))
 		(handle-evt (send (connection-session-room-handle conn) listen-evt)
 			    (match-lambda
 			     ((arrived _)