#lang racket/base
;; (Temporary) example client and server

(require racket/set)
(require racket/match)

(require "ssh-numbers.rkt")
(require "ssh-transport.rkt")
(require "ssh-message-types.rkt")
(require "ssh-exceptions.rkt")
(require "os2-support.rkt")

(define server-addr (tcp-listener 2322))

(define (connection-handler local-addr remote-addr)
  (nested-vm
   (list 'ssh-session-vm remote-addr)
   (transition 'running
     (at-meta-level
      (send-message (tcp-channel local-addr remote-addr #"SSH-2.0-RacketSSH_0.0\r\n")))
     (at-meta-level (send-tcp-mode remote-addr local-addr 'lines))
     (at-meta-level (send-tcp-credit remote-addr local-addr 1))
     (at-meta-level
      (role 'identification-handler (topic-subscriber %%%

     (spawn (ssh-reader local-addr remote-addr) #:debug-name 'ssh-reader)
     (spawn (ssh-writer local-addr remote-addr) #:debug-name 'ssh-writer)
     (yield #:state state
       (transition state (send-message (inbound-credit 1))))
     (role 'crash-listener
	 (set (topic-subscriber (wild) #:virtual? #t)
	      (topic-publisher (wild) #:virtual? #t))
       #:state state
       #:reason reason
       #:on-absence
       ;; This is kind of gross: because the absence handler gets
       ;; invoked several times in a row because of multiple flows
       ;; intersecting this role, we have to be careful to make the
       ;; transmission of the disconnection packet idempotent.
       (if (eq? state 'running)
	   (if (and (exn:fail:contract:protocol? reason)
		    (not (exn:fail:contract:protocol-originated-at-peer? reason)))
	       (transition 'error-packet-sent
		 (send-message (outbound-packet (ssh-msg-disconnect
						 (exn:fail:contract:protocol-reason-code reason)
						 (string->bytes/utf-8 (exn-message reason))
						 #"")))
		 (yield #:state state
		   (transition state (at-meta-level (kill)))))
	       (transition state (at-meta-level (kill #:reason reason))))
	   state)
       [msg
	(write (list 'SSH msg))
	(newline)
	(flush-output)
	state]))))

(ground-vm
 (transition 'no-state
   (spawn (timer-driver 'timer-driver))
   (spawn tcp-driver #:debug-name 'tcp-driver)
   (spawn tcp-spy #:debug-name 'tcp-spy)

   (spawn (transition 'no-state
	    (role 'connection-waiter (topic-subscriber (tcp-channel (wild) server-addr (wild))
						       #:virtual? #t)
	      #:state state
	      #:topic t
	      #:on-presence (match t
			      [(topic 'publisher (tcp-channel remote-addr (== server-addr) _) #t)
			       ;; Ignore virtual flows. They just mean there's
			       ;; someone willing to supply connections to us
			       ;; at some point in the future.
			       state]
			      [(topic 'publisher (tcp-channel remote-addr (== server-addr) _) #f)
			       (transition state
				 (spawn (connection-handler server-addr remote-addr)
					#:debug-name (list 'ssh-session-vm remote-addr)))]))))))