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

(require racket/tcp)
(require racket/pretty)
(require racket/match)
(require racket/class)
(require racket/port)
(require racket/sandbox)

(require "conversation.rkt")
(require "ssh-numbers.rkt")
(require "ssh-session.rkt")
(require "standard-thread.rkt")

(require "cook-port.rkt")

(define (t-client)
  (let-values (((i o) (tcp-connect "localhost"
				   2323
				   ;;22
				   )))
    (let ((api (ssh-session 'client i o)))
      (printf "Got API ~v\n" api)
      (semaphore-wait (make-semaphore 0)))))

(define (make-repl-channel-main username)
  (lambda (oob-ch in out)
    (define (run-shell in out)
      (define reader-thread
	(thread
	 (lambda ()
	   (fprintf out "Hello, ~a.\n" username)
	   (parameterize ((current-input-port in)
			  (current-output-port out)
			  (current-error-port out)
			  (sandbox-input in)
			  (sandbox-output out)
			  (sandbox-error-output out)
			  (current-namespace (make-empty-namespace)))
	     (parameterize ((current-eval (make-evaluator 'racket/base)))
	       (read-eval-print-loop))
	     (fprintf out "\nGoodbye!\n")
	     (close-input-port in)
	     (close-output-port out)))))
      (let loop ()
	(sync (handle-evt oob-ch
			  (match-lambda
			   (`(notify ,type ,data)
			    (log-info (format "repl-channel: notify ~v ~v" type data))
			    (loop))
			   (`(request ,other ,k)
			    (log-info (format "repl-channel: request ~v" other))
			    (k 'error)
			    (loop))))
	      (handle-evt reader-thread void))))

    (let update-channels ((in in) (out out))
      (let loop ()
	(sync (handle-evt oob-ch
			  (match-lambda
			   (`(notify ,type ,data)
			    (log-info (format "repl-channel: notify ~v ~v" type data))
			    (loop))
			   (`(request (#"pty-req" ,_) ,k)
			    (k 'ok)
			    (define-values (cooked-in cooked-out) (cook-io in out ""))
			    (update-channels cooked-in cooked-out))
			   (`(request (#"shell" ,_) ,k)
			    (k 'ok)
			    (run-shell in out))
			   (`(request ,other ,k)
			    (log-info (format "repl-channel: request ~v" other))
			    (k 'error)
			    (loop)))))))))

(define (t-server)
  (define s (tcp-listen 2322 4 #t "localhost"))
  (printf "Accepting...\n")
  (let loop ()
    (let-values (((i o) (tcp-accept s)))
      (standard-thread
       (lambda ()
	 (simple-ssh-server (ssh-session 'server i o)
			    (lambda (username channel-type extra-request-data state)
			      (match channel-type
				(#"session"
				 (values `(ok ,(make-repl-channel-main username) #"")
					 state))
				(else
				 (values `(error ,SSH_OPEN_UNKNOWN_CHANNEL_TYPE
						 "Unknown channel type")
					 state))))
			    'no-state)))
      (loop))))

(if (getenv "clientmode")
    (t-client)
    (t-server))