(* $Id: telnet_client.ml 126 2004-05-25 20:56:41Z gerd $
 * ----------------------------------------------------------------------
 *
 *)


(* NOTES:
 * - Every Unx or Unix system call wrapped with syscall
 *)


(* TODO:
 * - Sending Synch sequences could be done with higher priority. Currently,
 *   the output_buffer is first processed, then the synch_queue is copied
 *   to the output_buffer (and the output_queue is preempted for the moment).
 *   It is also possible to preempt the output_buffer, but this is much
 *   more complicated.
 *)

exception Telnet_protocol of exn;;


type telnet_command =
    Telnet_data of string
  | Telnet_nop
  | Telnet_dm           (* data mark *)
  | Telnet_brk          (* break *)
  | Telnet_ip           (* interrupt process *)
  | Telnet_ao           (* abort output *)
  | Telnet_ayt          (* are you there? *)
  | Telnet_ec           (* erase character *)
  | Telnet_el           (* erase line *)
  | Telnet_ga           (* Go ahead *)
  | Telnet_sb of char   (* Begin of subnegotiation *)
  | Telnet_se           (* End of subnegotation *)
  | Telnet_will of char (* Acknowledges that option is in effect *)
  | Telnet_wont of char (* Acknowledges that option is rejected *)
  | Telnet_do of char   (* Requests to turn on an option *)
  | Telnet_dont of char (* Requests to turn off an option *)
  | Telnet_unknown of char (* Unknown command *)
  | Telnet_eof          (* End of file *)
  | Telnet_timeout      (* Timeout event *)
;;


let prerr_command cmd =
  match cmd with
      Telnet_data s    -> prerr_endline ("Telnet: Data " ^ s)
    | Telnet_nop       -> prerr_endline "Telnet: NOP";
    | Telnet_dm        -> prerr_endline "Telnet: DM";
    | Telnet_brk       -> prerr_endline "Telnet: BRK";
    | Telnet_ip        -> prerr_endline "Telnet: IP";
    | Telnet_ao        -> prerr_endline "Telnet: AO";
    | Telnet_ayt       -> prerr_endline "Telnet: AYT";
    | Telnet_ec        -> prerr_endline "Telnet: EC";
    | Telnet_el        -> prerr_endline "Telnet: EL";
    | Telnet_ga        -> prerr_endline "Telnet: GA";
    | Telnet_sb c      -> prerr_endline ("Telnet: DB " ^ 
					 string_of_int(Char.code c));
    | Telnet_se        -> prerr_endline "Telnet: SE";
    | Telnet_will c    -> prerr_endline ("Telnet: WILL " ^
					 string_of_int(Char.code c));
    | Telnet_wont c    -> prerr_endline ("Telnet: WONT " ^
					 string_of_int(Char.code c));
    | Telnet_do c      -> prerr_endline ("Telnet: DO " ^
					 string_of_int(Char.code c));
    | Telnet_dont c    -> prerr_endline ("Telnet: DONT " ^
					 string_of_int(Char.code c));
    | Telnet_unknown c -> prerr_endline ("Telnet: unknown command " ^
					 string_of_int(Char.code c));
    | Telnet_eof       -> prerr_endline "Telnet: <eof>";
    | Telnet_timeout   -> prerr_endline "Telnet: <timeout>";
;;


type sockstate =
    Down
  | Up_rw 
  | Up_r
;;


type telnet_options =
    { connection_timeout : float;
      verbose_connection : bool;
      verbose_input : bool;
      verbose_output : bool;
    }
;;


type telnet_negotiated_option =
    Telnet_binary       (* see RFC 856 *)
  | Telnet_echo         (* see RFC 857 *)
  | Telnet_suppress_GA  (* see RFC 858 *)
  | Telnet_status       (* see RFC 859 *)
  | Telnet_timing_mark  (* see RFC 860 *)
  | Telnet_ext_opt_list (* see RFC 861 *)
  | Telnet_end_of_rec   (* see RFC 885 *)
  | Telnet_window_size  (* see RFC 1073 *)
  | Telnet_term_speed   (* see RFC 1079 *)
  | Telnet_term_type    (* see RFC 1091 *)
  | Telnet_X_display    (* see RFC 1096 *)
  | Telnet_linemode     (* see RFC 1184 *)
  | Telnet_flow_ctrl    (* see RFC 1372 *)
  | Telnet_auth         (* see RFC 1416 *)
  | Telnet_new_environ  (* see RFC 1572 and 1571 *)
  | Telnet_option of int   (* all other options *)
;;


type telnet_option_state =
    Not_negotiated
  | Accepted
  | Rejected
;;


module Aux = Http_client_aux


let rec syscall f =  (* TODO: move to Aux *)
  (* Invoke system call, and handle EINTR *)
  try
    f()
  with
      Unix.Unix_error(Unix.EINTR,_,_) ->
	(* "interrupted system call": A signal happened while the system
	 * blocked.
	 * Simply restart the call.
	 *)
	syscall f
;;


let char_of_option p =
  match p with
    Telnet_binary       -> '\000'
  | Telnet_echo         -> '\001'
  | Telnet_suppress_GA  -> '\003'
  | Telnet_status       -> '\005'
  | Telnet_timing_mark  -> '\006'
  | Telnet_ext_opt_list -> '\255'
  | Telnet_end_of_rec   -> '\025'
  | Telnet_window_size  -> '\031'
  | Telnet_term_speed   -> '\032'
  | Telnet_term_type    -> '\024'
  | Telnet_X_display    -> '\035'
  | Telnet_linemode     -> '\034'
  | Telnet_flow_ctrl    -> '\033'
  | Telnet_auth         -> '\037'
  | Telnet_new_environ  -> '\039'
  | Telnet_option k     -> Char.chr k
;;


let option_of_char c =
  match c with
      '\000' -> Telnet_binary
    | '\001' -> Telnet_echo
    | '\003' -> Telnet_suppress_GA
    | '\005' -> Telnet_status
    | '\006' -> Telnet_timing_mark
    | '\255' -> Telnet_ext_opt_list
    | '\025' -> Telnet_end_of_rec
    | '\031' -> Telnet_window_size
    | '\032' -> Telnet_term_speed
    | '\024' -> Telnet_term_type
    | '\035' -> Telnet_X_display
    | '\034' -> Telnet_linemode
    | '\033' -> Telnet_flow_ctrl
    | '\037' -> Telnet_auth
    | '\039' -> Telnet_new_environ
    | k      -> Telnet_option (Char.code k)
;;


type telnet_connector =
    Telnet_connect of (string * int)
  | Telnet_socket of Unix.file_descr
;;


class telnet_session =
  object (self)
    val mutable connector = Telnet_connect("",0)

    val mutable esys = Unixqueue.create_unix_event_system()

    val mutable callback =
	    (fun _ -> () : bool -> unit)
	(* the argument indicates whether urgent processing has been requested
	 * or not.
	 *)

    val mutable output_queue = Queue.create()
    val mutable synch_queue = Queue.create()
    val mutable input_queue = Queue.create()

    val mutable output_buffer = Netbuffer.create 8192
    val mutable input_buffer = Netbuffer.create 8192
    val mutable primary_buffer = String.create 8192 
    val mutable send_eof = false
    val mutable sending_urgent_data = false

    val mutable group = None
    val mutable socket = Unix.stdin
    val mutable socket_state = Down
    val mutable connecting = false
    val mutable polling_wr = false
    val mutable input_timed_out = false
    val mutable output_timed_out = false

    val mutable options = 
	    { connection_timeout = 300.0;
	      verbose_connection = false;
	      verbose_input = false;
	      verbose_output = false;
	    }

    val mutable enabled_local_options = []
    val mutable offered_local_options = []
    val mutable state_local_options = []       
		(* does not contain options with state Not_negotiated *)

    val mutable enabled_remote_options = []
    val mutable requested_remote_options = []
    val mutable state_remote_options = []
		(* does not contain options with state Not_negotiated *)

    val mutable exn_handler = (fun _ -> ())


    initializer
      exn_handler <-
        (fun x ->
	   self # reset ();
	   match x with
	       Telnet_protocol x' ->
		 raise x          (* Never wrap twice *)
	     | _ ->
		 raise (Telnet_protocol x))


    method set_connection c =
      connector <- c
      

    method set_event_system new_ues =
      esys <- new_ues


    method set_callback cb =
      callback <- cb


    method set_exception_handler xh =
      exn_handler <- xh


    method output_queue = output_queue

    method input_queue = input_queue

    method get_options = options

    method set_options p = 
      options <- p

    method reset() =
      self # abort_connection;
      Queue.clear input_queue;
      Queue.clear output_queue;
      Queue.clear synch_queue;
      Netbuffer.clear input_buffer;
      Netbuffer.clear output_buffer;

    method enable_local_option p =
      if not (List.mem p enabled_local_options) then
	enabled_local_options <- p :: enabled_local_options


    method disable_local_option p =
      if List.mem p enabled_local_options then
	enabled_local_options <- List.filter (fun p' -> p <> p) 
	                                     enabled_local_options;
      if self # get_local_option p = Accepted then
	Queue.add (Telnet_wont (char_of_option p)) output_queue;


    method offer_local_option p = 
      if not (List.mem p offered_local_options) &
	self # get_local_option p <> Accepted  then begin
	offered_local_options <- p :: offered_local_options;
	Queue.add (Telnet_will (char_of_option p)) output_queue
      end


    method enable_remote_option p =
      if not (List.mem p enabled_remote_options) then
	enabled_remote_options <- p :: enabled_remote_options


    method disable_remote_option p =
      if List.mem p enabled_remote_options then
	enabled_remote_options <- List.filter (fun p' -> p <> p) 
	                                       enabled_remote_options;
      if self # get_remote_option p = Accepted then
	Queue.add (Telnet_dont (char_of_option p)) output_queue;


    method request_remote_option p = 
      if not (List.mem p requested_remote_options) &
	 self # get_remote_option p <> Accepted then begin
	requested_remote_options <- p ::requested_remote_options;
	Queue.add (Telnet_do (char_of_option p)) output_queue
      end


    method reset_local_option p =
      state_local_options <- List.filter 
	                       (fun (p',_) -> p <> p') 
	                       state_local_options


    method reset_remote_option p =
      state_remote_options <- List.filter 
	                       (fun (p',_) -> p <> p') 
	                       state_remote_options


    method get_local_option p =
      try
	List.assoc p state_local_options
      with Not_found -> Not_negotiated


    method get_remote_option p =
      try
	List.assoc p state_remote_options
      with Not_found -> Not_negotiated


    method option_negotiation_is_over =
      offered_local_options = [] & requested_remote_options = []


    method process_option_command cmd =
      match cmd with
	  Telnet_will c ->
	    (* If we previously requested the option, it is now in effect. *)
	    let p = option_of_char c in
	    let new_state =
	      if List.mem p requested_remote_options then begin
		requested_remote_options <- List.filter
		                              (fun p' -> p <> p')
		                              requested_remote_options;
		Accepted
	      end
	      else begin
		(* Otherwise accept the option if enabled, and reject if
		 * disabled.
		 *)
		if List.mem p enabled_remote_options then begin
		  Queue.add (Telnet_do c) output_queue;
		  Accepted
		end
		else begin
		  Queue.add (Telnet_dont c) output_queue;
		  Rejected
		end
	      end
	    in
	    state_remote_options <- (p, new_state) ::
	                            List.filter
		                      (fun (p',_) -> p <> p')
		                      state_remote_options;
	| Telnet_wont c ->
	    (* The option is rejected *)
	    let p = option_of_char c in
	    state_remote_options <- (p, Rejected) ::
	                            List.filter
		                      (fun (p',_) -> p <> p')
		                      state_remote_options;
	    requested_remote_options <- List.filter
		                          (fun p' -> p <> p')
		                          requested_remote_options;
	| Telnet_do c ->
	    (* If we previously offered the option, it is now in effect. *)
	    let p = option_of_char c in
	    let new_state =
	      if List.mem p offered_local_options then begin
		offered_local_options <- List.filter
		                           (fun p' -> p <> p')
		                           offered_local_options;
		Accepted
	      end
	      else begin
		(* Otherwise accept the option if enabled, and reject if
		 * disabled.
		 *)
		if List.mem p enabled_local_options then begin
		  Queue.add (Telnet_will c) output_queue;
		  Accepted
		end
		else begin
		  Queue.add (Telnet_wont c) output_queue;
		  Rejected
		end
	      end
	    in
	    state_local_options <- (p, new_state) ::
	                           List.filter
		                     (fun (p',_) -> p <> p')
		                     state_local_options;
	| Telnet_dont c ->
	    (* The option is rejected *)
	    let p = option_of_char c in
	    state_local_options <- (p, Rejected) ::
	                            List.filter
		                      (fun (p',_) -> p <> p')
		                      state_local_options;
	    offered_local_options <- List.filter
		                       (fun p' -> p <> p')
		                       offered_local_options;
	| _ ->
	    ()


    method fetch_subnegotiation =
      if Queue.length input_queue >= 1 then begin
	let para = ref "" in
	let n = ref 0 in
	let ended = ref false in
	begin 
	  try
	    Queue.iter
	      (function 
		   Telnet_data s ->
		     incr n;
		     para := !para ^ s
		 | Telnet_se ->
		     incr n;
		     ended := true;
		     raise Not_found   (* Exit 'iter' *)
		 | _ ->
		     raise Not_found)  (* Exit 'iter' *)
	      input_queue;
		with
		    Not_found -> ()
	end;
	if !ended then begin
	  (* Discard the first n elements of the queue *)
	  for i = 1 to !n do
	    ignore(Queue.take input_queue)
	  done;
	  Some !para
	end
	else None
      end
      else None


    method attach() =
      if group <> None then
	failwith "Telnet_client: already attached";

      let g = Unixqueue.new_group esys in

      let g1 = Unixqueue.new_group esys in  (* group for deferred 'connect' *)
      Unixqueue.once 
	esys
	g1
	0.0
	(fun () -> 
	   try
	     self # connect_server;
	     (* 'group' must not be set earlier, because it is used as
	      * indicator whether a connection is established or not.
	      *)
	     group <- Some g;
	     let timeout_value = options.connection_timeout in
	     Unixqueue.add_resource esys g (Unixqueue.Wait_in socket, 
					    timeout_value);
	     Unixqueue.add_close_action esys g (socket, 
						(fun _ -> self # shutdown));
	     Unixqueue.add_handler esys g (self # handler);
	     polling_wr <- false;
	     self # maintain_polling;
	   with
	       Unix.Unix_error(_,_,_) as x -> exn_handler x
	     | Sys_error _ as x -> exn_handler x
	)


    method run() = 
      Unixqueue.run esys


    method update() =
      if group <> None then
	self # maintain_polling;


    method send_synch cmds =
      List.iter
	(fun cmd ->
	   Queue.add cmd synch_queue)
	cmds;
      Queue.add Telnet_dm synch_queue;
      self # update()


    method private inet_addr hostname =
      try
	(* TODO: 'inet_addr_of_string' may block *)
	syscall (fun () -> Unix.inet_addr_of_string (Aux.match_ip hostname))
      with
	  Not_found ->
	    try
	      let h = syscall (fun () -> Unix.gethostbyname hostname) in
	      h.Unix.h_addr_list.(0)
	    with Not_found ->
	      raise 
		(Sys_error 
		   ("Telnet_client: host name lookup failed for " ^ hostname));


    method private connect_server =

      begin match connector with
	  Telnet_connect(hostname, port) ->
	    if options.verbose_connection then
	      prerr_endline ("Telnet connection: Connecting to server " ^ 
			     hostname);

	    let addr = self # inet_addr hostname in

	    let s = syscall 
		      (fun () -> Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0) in
	    (* Connect in non-blocking mode: *)
	    syscall (fun () -> Unix.set_nonblock s);
	    (* Urgent data is received inline: *)
	    syscall (fun () -> Unix.setsockopt s Unix.SO_OOBINLINE true);
	    begin try
	      syscall (fun () -> Unix.connect s (Unix.ADDR_INET (addr, port)));
	      connecting <- false;
	      if options.verbose_connection then
		prerr_endline "Telnet connection: Connected!";
	    with
		Unix.Unix_error(Unix.EINPROGRESS,_,_) ->
		  (* The 'connect' has not yet been finished. *)
		  connecting <- true;
		  (* The 'connect' operation continues in the background.
		   * It is guaranteed that the socket becomes writeable if
		   * the connection is established.
		   * (Of course, it becomes readable if there is already data
		   * to read, but if the other side does not send us anything
		   * only writeability is indicated.)
		   * If the connection fails: This situation is not very well
		   * described in the manual pages. The "Single Unix Spec"
		   * says nothing about this case. In the Linux manpages I 
		   * found that it is possible to read the O_ERROR socket option
		   * (see connect(2)). By experience I found out that the socket
		   * indicates readability, and that the following "read" 
		   * syscall then reports the error correctly.
		   * The O_ERROR socket option is not supported by O'Caml, so
		   * the latter is assumed.
		   *)
	      | any ->
		  syscall (fun () -> Unix.close s);
		  raise any;
	    end;

	    socket <- s;

	| Telnet_socket s ->
	    connecting <- false;
	    syscall(fun () -> Unix.setsockopt s Unix.SO_OOBINLINE true);
	    socket <- s;
	    if options.verbose_connection then
	      prerr_endline "Telnet connection: Got connected socket";
      end;
      
      socket_state <- Up_rw;
      Netbuffer.clear input_buffer;
      Netbuffer.clear output_buffer;
      Queue.clear input_queue;
      send_eof <- false;
      sending_urgent_data <- false;
      input_timed_out <- false;
      output_timed_out <- false;


    method private shutdown =
      if options.verbose_connection then 
	prerr_endline "Telnet connection: Shutdown!";
      begin match socket_state with
	  Down -> ()
	| (Up_rw | Up_r) -> 
	    if options.verbose_connection then 
	      prerr_endline "Telnet connection: Closing socket!";
	    try
	      syscall (fun () -> Unix.close socket)
	    with
		_ -> ()           (* ignore failed 'close' *)
      end;
      socket_state <- Down;
      match group with
	  Some g -> 
	    Unixqueue.clear esys g;
	    group <- None;
	| None ->  ()


    method private abort_connection =

      (* By removing the input and output resources, the event queue is told
       * that nothing more will be done with the group g, and because of this
       * the queue invokes the 'close action' (here self # shutdown) and
       * cleans up the queue.
       *)
      match group with
	  Some g -> 
	    Unixqueue.remove_resource esys g (Unixqueue.Wait_in socket);
	    if polling_wr then begin
	      Unixqueue.remove_resource esys g (Unixqueue.Wait_out socket);
	      polling_wr <- false;
	    end;
	    assert (group = None);
        | None -> 
	    ()


    method private maintain_polling =

      (* If one of the following conditions is true, we need not to poll
       * the write side of the socket:
       * - The write_queue is empty and the synch_queue is empty
       *)

      let timeout_value = options.connection_timeout in

      if (Queue.length output_queue = 0 & Queue.length synch_queue = 0)
      then begin
	if polling_wr then begin
	  let g = match group with
	      Some x -> x
	    | None -> assert false
	  in
(*  prerr_endline "REMOVE";   *)
	  Unixqueue.remove_resource esys g (Unixqueue.Wait_out socket);
	end;
	polling_wr <- false
      end;

      (* On the other hand, all of the following conditions must be true
       * to enable polling again:
       * - The write_queue is not empty or the synch_queue is not empty
       *)

      if (Queue.length output_queue > 0 or Queue.length synch_queue > 0)
      then begin
	if not polling_wr then begin
	  let g = match group with
	      Some x -> x
	    | None -> assert false
	  in
(*  prerr_endline "ADD";    *)
	  Unixqueue.add_resource esys g (Unixqueue.Wait_out socket, 
					 timeout_value
					);
	end;
	polling_wr <- true;
      end;


    method private check_connection =
      (* You need to call this method only if 'connecting' is true, and of
       * course if the socket is either readable or writeable.
       * The socket is set to blocking mode, again. The connect time
       * is measured and recorded.
       * TODO: find out if a socket error happened in the meantime.
       *)
      if connecting then begin
	syscall(fun () -> Unix.clear_nonblock socket);
	connecting <- false;
	if options.verbose_connection then
	  prerr_endline "Telnet connection: Got connection status";
      end


    method private handler  _ _ ev =
      let g = match group with
	  Some x -> x
	| None -> 
	    (* This is possible while shutting down the socket *)
	    raise Equeue.Reject
      in
      match ev with
	  Unixqueue.Input_arrived (g0,fd0) ->
	    if g0 = g then 
	      try self # handle_input with 
		  Unix.Unix_error(_,_,_) as x -> exn_handler x
	    else raise Equeue.Reject
	| Unixqueue.Output_readiness (g0,fd0) ->
	    if g0 = g then 
	      try self # handle_output with 
		  Unix.Unix_error(_,_,_) as x -> exn_handler x
	    else raise Equeue.Reject
	| Unixqueue.Timeout (g0, op) ->
	    if g0 = g then 
	      try self # handle_timeout op with 
		  Unix.Unix_error(_,_,_) as x -> exn_handler x
	    else raise Equeue.Reject
	| _ ->
	    raise Equeue.Reject

    (**********************************************************************)
    (***                    THE TIMEOUT HANDLER                         ***)
    (**********************************************************************)

    method private handle_timeout op =
      begin match op with
	  Unixqueue.Wait_in _  -> input_timed_out  <- true
	| Unixqueue.Wait_out _ -> output_timed_out <- true
	| _ -> ()
      end;

      if input_timed_out & output_timed_out then begin
	(* No network packet arrived for a period of time.
	 * May happen while connecting to a server, or during operation.
	 *)
	if socket_state = Down then
	  raise Equeue.Reject;
	
	Queue.add Telnet_timeout input_queue;
	
	if options.verbose_connection then 
	  prerr_endline "Telnet connection: Timeout event!";
	
	self # abort_connection;
	
        (* Invoke the callback function: *)

	callback false;
      end


    (**********************************************************************)
    (***                     THE INPUT HANDLER                          ***)
    (**********************************************************************)

    method private handle_input =
      (* Data have arrived on the 'socket'. First we receive as much as we
       * can; then the data are interpreted as sequence of messages.
       *)
      
      (* Ignore this event if the socket is Down (this may happen
       * if the input side is closed while there are still input
       * events in the queue):
       *)
      if socket_state = Down then
	raise Equeue.Reject;

      input_timed_out <- false;

      if options.verbose_connection then 
	prerr_endline "Telnet connection: Input event!";

      let g = match group with
	  Some x -> x
	| None -> assert false
      in
      
      if connecting then
	self # check_connection;

      (* Read data into the primary_buffer *)

      let n =
	syscall
	  (fun () ->
	     Unix.read socket primary_buffer 0 (String.length primary_buffer)) in
      let eof = (n=0) in

      Netbuffer.add_sub_string input_buffer primary_buffer 0 n;

      (* Interpret the octet stream in 'input_buffer' as sequence of
       * commands
       *)
      
      let length = Netbuffer.length input_buffer in
      let buffer = Netbuffer.unsafe_buffer input_buffer in

      let is_urgent = ref false in

      let finish pos =
	Netbuffer.delete input_buffer 0 pos
      in

      let clear_data_path() =
	(* remove any non-urgent data *)
	let new_queue = Queue.create() in
	let within_sb = ref false in
	Queue.iter
	  (fun cmd ->
	     match cmd with
		(Telnet_nop | Telnet_dm | Telnet_brk | Telnet_ip | Telnet_ao |
		 Telnet_ayt | Telnet_ga | 
		 Telnet_will _ | Telnet_wont _ | Telnet_do _ |
		 Telnet_dont _ | Telnet_unknown _ | Telnet_eof | Telnet_timeout)
		 ->
		   Queue.add cmd new_queue
	       | Telnet_sb c ->
		   Queue.add cmd new_queue;
		   within_sb := true
	       | Telnet_se ->
		   Queue.add cmd new_queue;
		   within_sb := false
	       | _ -> 
		   if !within_sb then Queue.add cmd new_queue;
	  )
	  input_queue;
	input_queue <- new_queue
      in
      
      let rec interpret pos =
	if pos >= length then
	  finish length
	else
	  match buffer.[pos] with
	      '\255' -> 
		(* IAC character *)
		if pos+1 < length then begin
		  match buffer.[pos+1] with
		    | '\240' -> Queue.add Telnet_se input_queue;
			        interpret(pos+2);
		    | '\241' -> Queue.add Telnet_nop input_queue;
			        interpret(pos+2)
		    | '\242' -> clear_data_path();
			        Queue.add Telnet_dm input_queue;
				is_urgent := true;
			        interpret(pos+2)
		    | '\243' -> Queue.add Telnet_brk input_queue;
			        interpret(pos+2)
		    | '\244' -> Queue.add Telnet_ip input_queue;
			        interpret(pos+2)
		    | '\245' -> Queue.add Telnet_ao input_queue;
			        interpret(pos+2)
		    | '\246' -> Queue.add Telnet_ayt input_queue;
			        interpret(pos+2)
		    | '\247' -> Queue.add Telnet_ec input_queue;
			        interpret(pos+2)
      		    | '\248' -> Queue.add Telnet_el input_queue;
			        interpret(pos+2)
		    | '\249' -> Queue.add Telnet_ga input_queue;
			        interpret(pos+2)
		    | '\255' -> Queue.add (Telnet_data(String.make 1 '\255'))
			                  input_queue;
			        interpret(pos+2)
		    | ('\240'|'\250'..'\254') ->
			if pos+2 < length then begin
			  let option = buffer.[pos+2] in
			  match buffer.[pos+1] with
			    | '\250' -> Queue.add (Telnet_sb option) 
				                  input_queue;
				        interpret(pos+3);
			    | '\251' -> Queue.add (Telnet_will option) 
				                  input_queue;
				        interpret(pos+3);
			    | '\252' -> Queue.add (Telnet_wont option) 
				                  input_queue;
				        interpret(pos+3);
			    | '\253' -> Queue.add (Telnet_do option) 
				                  input_queue;
				        interpret(pos+3);
			    | '\254' -> Queue.add (Telnet_dont option) 
				                  input_queue;
				        interpret(pos+3);
			    | _ -> assert false
			end
			else finish pos
		    | _ -> Queue.add (Telnet_unknown(buffer.[pos+1]))
			             input_queue;
			   interpret(pos+2);
		end
		else finish pos
	    | c ->
		begin try 
		  let pos' = Netbuffer.index_from input_buffer pos '\255' in
		  Queue.add 
		    (Telnet_data(Netbuffer.sub input_buffer pos (pos'-pos)))
		    input_queue;
		  interpret pos'
		with
		    Not_found ->
		      Queue.add 
			(Telnet_data
			   (Netbuffer.sub input_buffer pos (length-pos)))
			input_queue;
		      finish length
		end
      in

      if eof then begin
	if options.verbose_connection then
	  prerr_endline "Telnet connection: Got EOF";
	Queue.add Telnet_eof input_queue;
	self # abort_connection;
      end
      else
	interpret 0;

      if options.verbose_input then begin
	prerr_endline "Telnet input queue:";
	Queue.iter prerr_command input_queue;
	prerr_endline "Telnet: <end of queue>";
      end;


      (* TODO: Find out whether urgent data arrived, and remove all non-
       * commands from the queue.
       *)

      (* Invoke the callback function: *)

      callback !is_urgent;

      (* Now there may be new elements on the write queue. *)

      self # maintain_polling;


    (**********************************************************************)
    (***                     THE OUTPUT HANDLER                         ***)
    (**********************************************************************)

    method private handle_output =

      (* Ignore this event if the socket is not Up_rw (this may happen
       * if the output side is closed while there are still output
       * events in the queue):
       *)
      if socket_state <> Up_rw then
	raise Equeue.Reject;

      output_timed_out <- false;

      if options.verbose_connection then 
	prerr_endline "Telnet connection: Output event!";

      let g = match group with
	  Some x -> x
	| None -> assert false
      in

      if connecting then
	self # check_connection;

      (* If the write buffer is empty, copy new commands from the write
       * queue to the write buffer.
       *)

      let rec copy_string s pos =
	try
	  let pos' = String.index_from s pos '\255' in
	  Netbuffer.add_string output_buffer (String.sub s pos (pos'-pos));
	  Netbuffer.add_string output_buffer "\255\255";
	  copy_string s (pos'+1)
	with
	    Not_found ->
	      if pos = 0 then
		Netbuffer.add_string output_buffer s
	      else
		let l = String.length s in
		Netbuffer.add_sub_string output_buffer s pos (l-pos)
      in

      let q = 
	if Queue.length synch_queue > 0 then	  
	  synch_queue
	else
	  output_queue in

      let rec copy () =
	match Queue.take q with
	    Telnet_data s ->
	      copy_string s 0;
	      copy()
	  | Telnet_nop ->
	      Netbuffer.add_string output_buffer "\255\241";
	      copy();
	  | Telnet_dm ->
	      Netbuffer.add_string output_buffer "\255\242";
	      copy();
	  | Telnet_brk ->
	      Netbuffer.add_string output_buffer "\255\243";
	      copy();
	  | Telnet_ip ->
	      Netbuffer.add_string output_buffer "\255\244";
	      copy();
	  | Telnet_ao ->
	      Netbuffer.add_string output_buffer "\255\245";
	      copy();
	  | Telnet_ayt ->
	      Netbuffer.add_string output_buffer "\255\246";
	      copy();
	  | Telnet_ec ->
	      Netbuffer.add_string output_buffer "\255\247";
	      copy();
	  | Telnet_el ->
	      Netbuffer.add_string output_buffer "\255\248";
	      copy();
	  | Telnet_ga ->
	      Netbuffer.add_string output_buffer "\255\249";
	      copy();
	  | Telnet_sb c ->
	      Netbuffer.add_string output_buffer "\255\250";
	      Netbuffer.add_string output_buffer (String.make 1 c);
	      copy();
	  | Telnet_se ->
	      Netbuffer.add_string output_buffer "\255\240";
	      copy();
	  | Telnet_will c ->
	      Netbuffer.add_string output_buffer "\255\251";
	      Netbuffer.add_string output_buffer (String.make 1 c);
	      copy();
	  | Telnet_wont c ->
	      Netbuffer.add_string output_buffer "\255\252";
	      Netbuffer.add_string output_buffer (String.make 1 c);
	      copy();
	  | Telnet_do c ->
	      Netbuffer.add_string output_buffer "\255\253";
	      Netbuffer.add_string output_buffer (String.make 1 c);
	      copy();
	  | Telnet_dont c ->
	      Netbuffer.add_string output_buffer "\255\254";
	      Netbuffer.add_string output_buffer (String.make 1 c);
	      copy();
	  | Telnet_unknown c ->
	      Netbuffer.add_string output_buffer "\255";
	      Netbuffer.add_string output_buffer (String.make 1 c);
	      copy();
	  | Telnet_eof ->
	      send_eof <- true;
	      Queue.clear output_queue;
	      Queue.clear synch_queue;
	  | Telnet_timeout ->
	      copy()
      in

      if Netbuffer.length output_buffer = 0 then begin

	if q == synch_queue then begin
	  sending_urgent_data <- true;
	  if options.verbose_connection then
	    prerr_endline "Sending urgent data";
	end
	else
	  sending_urgent_data <- false;

	if options.verbose_output then begin
	  prerr_endline "Telnet output queue:";
	  Queue.iter prerr_command output_queue;
	  prerr_endline "Telnet: <end of queue>";
	end;

	try copy() with Queue.Empty -> ()
      end;

      let l = Netbuffer.length output_buffer in
      if l > 0 then begin
	let flags =
	  if sending_urgent_data then [ Unix.MSG_OOB ] else [] in
	let k = 
	  syscall
	    (fun () ->
	       Unix.send socket (Netbuffer.unsafe_buffer output_buffer) 0 l flags) in
	Netbuffer.delete output_buffer 0 k;
      end;

      if Netbuffer.length output_buffer = 0 & send_eof then begin
	if options.verbose_connection then
	  prerr_endline "Telnet connection: Sending EOF";
	syscall(fun () -> Unix.shutdown socket Unix.SHUTDOWN_SEND);
	socket_state <- Up_r;
      end;

      self # maintain_polling;
  end
;;