Changeset 3542

Timestamp:

Feb 11, 2013 5:58:33 AM (3 months ago)

Author:

quozl

Message:

OLPC - telnetd, allow subsequent reconnections, display IP address of client, suppress 300ms options negotiation allowing to occur during normal mux I/O, also fixes #12539.

File:

• ofw/inet/telnetd.fth (modified) (7 diffs)

ofw/inet/telnetd.fth

@@ -8 +8 @@
 support-package: telnet
 false value debug-options?
+false value verbose?
+false value listening?
 
 : (read)  ( adr len -- actual )  " read" $call-parent  ;
@@ -131 +133 @@
 \ The Windows telnet client sends CR-LF per the Telnet NVT spec.
 \ The Linux telnet client just sends CR.
-0 value last-was-cr?
+false value last-was-cr?
 
 : do-lf  ( adr len -- adr' len' )
@@ -149 +151 @@
    drop swap -                                 ( len' )
 ;
-: read  ( adr len -- actual )
-   over swap  (read)              ( adr actual )
-   dup 0<  if  nip exit  then     ( adr actual )
-   process-escapes                ( actual' )
-;
-: write  ( adr len -- actual )
+
+: .his-ip-addr  ( -- )
+   " his-ip-addr" $call-parent .ipaddr
+;
+
+: accept?  ( -- connected? )
+   d# 23 " accept" $call-parent  0=  if  false exit  then
+
+   verbose?  if  ." telnetd: connection from "  .his-ip-addr cr  then
+
+   3 send-do            \ You suppress go-ahead
+   0 send-do            \ Be binary
+   1 send-will          \ I will echo
+   false to listening?
+   false to last-was-cr?
+   true
+;
+
+: disconnect  ( -- )
+   " disconnect" $call-parent
+   verbose?  if  ." telnetd: connection closed by " .his-ip-addr cr  then
+   true to listening?
+;
+
+: read  ( adr len -- actual|-1|-2 )
+   listening?  if  accept? drop  2drop  -2  exit  then
+   over swap  (read)                            ( adr actual )
+   dup case                                     ( adr actual )
+      -1  of  disconnect  nip exit  endof
+      -2  of              nip exit  endof
+   endcase
+   process-escapes                              ( actual' )
+;
+: write  ( adr len -- actual|-1 )
+   listening?  if 2drop  -1  exit  then
    tuck  begin                ( len adr len )
       #iac split-string       ( len head$ tail$ )
@@ -166 +197 @@
 ;
 
-0 instance value verbose?
-
 : open  ( -- flag )
+   true to listening?
    my-args " verbose" $=  to verbose?
 
@@ -175 +205 @@
    then
 
-   begin  d# 23 " accept" $call-parent  until
+   begin  accept?  until
 
    verbose?  if  ." Connected" cr  then
-
-   3 send-do            \ You suppress go-ahead
-   0 send-do            \ Be binary
-   1 send-will          \ I will echo
-
-   get-msecs        ( time )
-   begin
-      get-msecs over d# 300 +  -  0<
-   while
-      the-byte h# 10 (read)  dup  0<  if          ( msecs count )
-         \ Bail out if the connection closed
-         -1 =  if  drop false exit  then
-
-         \ The other alternative is -2, meaning no bytes available.
-         \ In that case, we'll eventually time out.
-      else                                        ( msecs count )
-         \ Keep advancing the timeout while bytes are still coming in
-         the-byte swap process-escapes drop      ( msecs )
-         drop get-msecs
-      then
-   repeat
-   drop
-
-   false to last-was-cr?
 
    true
@@ -211 +217 @@
 0 value telnet-ih
 
-defer getchar-hook  ' = to getchar-hook
-patch getchar-hook =  stdin-getchar
-
 : exit-telnet  ( -- )
-   telnet-ih remove-output
-   telnet-ih remove-input
-   telnet-ih close-dev
-   ['] = to getchar-hook
-;
-
-: ?telnet-closed  ( read-return 1 -- flag )
-   over  -1 =  if              ( -1 1 )
-      exit-telnet              ( -1 1 )
-      carret pending-char c!   ( 1 1 ) 
-      ." Connection closed" \ cr
-      2drop true exit
-   then                        ( read-return 1 )
-   =
+   telnet-ih  0=  if  exit  then
+
+   " verbose?" telnet-ih $call-method   ( verbose? )
+   telnet-ih remove-output              ( verbose? )
+   telnet-ih remove-input               ( verbose? )
+   telnet-ih close-dev                  ( verbose? )
+   0 to telnet-ih                       ( verbose? )
+   if  ." telnetd: off" cr  then        ( )
 ;
 
@@ -239 +236 @@
    telnet-ih add-input
    \ hint: use " screen-ih remove-output " to speed up your telnet output
-   ['] ?telnet-closed to getchar-hook
 ;
 \ LICENSE_BEGIN