Changeset 3542


Ignore:
Timestamp:
Feb 11, 2013, 5:58:33 AM (23 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:
1 edited

Legend:

Unmodified
Added
Removed
  • ofw/inet/telnetd.fth

    r3518 r3542  
    88support-package: telnet 
    99false value debug-options? 
     10false value verbose? 
     11false value listening? 
    1012 
    1113: (read)  ( adr len -- actual )  " read" $call-parent  ; 
     
    131133\ The Windows telnet client sends CR-LF per the Telnet NVT spec. 
    132134\ The Linux telnet client just sends CR. 
    133 0 value last-was-cr? 
     135false value last-was-cr? 
    134136 
    135137: do-lf  ( adr len -- adr' len' ) 
     
    149151   drop swap -                                 ( len' ) 
    150152; 
    151 : read  ( adr len -- actual ) 
    152    over swap  (read)              ( adr actual ) 
    153    dup 0<  if  nip exit  then     ( adr actual ) 
    154    process-escapes                ( actual' ) 
    155 ; 
    156 : write  ( adr len -- actual ) 
     153 
     154: .his-ip-addr  ( -- ) 
     155   " his-ip-addr" $call-parent .ipaddr 
     156; 
     157 
     158: accept?  ( -- connected? ) 
     159   d# 23 " accept" $call-parent  0=  if  false exit  then 
     160 
     161   verbose?  if  ." telnetd: connection from "  .his-ip-addr cr  then 
     162 
     163   3 send-do            \ You suppress go-ahead 
     164   0 send-do            \ Be binary 
     165   1 send-will          \ I will echo 
     166   false to listening? 
     167   false to last-was-cr? 
     168   true 
     169; 
     170 
     171: disconnect  ( -- ) 
     172   " disconnect" $call-parent 
     173   verbose?  if  ." telnetd: connection closed by " .his-ip-addr cr  then 
     174   true to listening? 
     175; 
     176 
     177: read  ( adr len -- actual|-1|-2 ) 
     178   listening?  if  accept? drop  2drop  -2  exit  then 
     179   over swap  (read)                            ( adr actual ) 
     180   dup case                                     ( adr actual ) 
     181      -1  of  disconnect  nip exit  endof 
     182      -2  of              nip exit  endof 
     183   endcase 
     184   process-escapes                              ( actual' ) 
     185; 
     186: write  ( adr len -- actual|-1 ) 
     187   listening?  if 2drop  -1  exit  then 
    157188   tuck  begin                ( len adr len ) 
    158189      #iac split-string       ( len head$ tail$ ) 
     
    166197; 
    167198 
    168 0 instance value verbose? 
    169  
    170199: open  ( -- flag ) 
     200   true to listening? 
    171201   my-args " verbose" $=  to verbose? 
    172202 
     
    175205   then 
    176206 
    177    begin  d# 23 " accept" $call-parent  until 
     207   begin  accept?  until 
    178208 
    179209   verbose?  if  ." Connected" cr  then 
    180  
    181    3 send-do            \ You suppress go-ahead 
    182    0 send-do            \ Be binary 
    183    1 send-will          \ I will echo 
    184  
    185    get-msecs        ( time ) 
    186    begin 
    187       get-msecs over d# 300 +  -  0< 
    188    while 
    189       the-byte h# 10 (read)  dup  0<  if          ( msecs count ) 
    190          \ Bail out if the connection closed 
    191          -1 =  if  drop false exit  then 
    192  
    193          \ The other alternative is -2, meaning no bytes available. 
    194          \ In that case, we'll eventually time out. 
    195       else                                        ( msecs count ) 
    196          \ Keep advancing the timeout while bytes are still coming in 
    197          the-byte swap process-escapes drop      ( msecs ) 
    198          drop get-msecs 
    199       then 
    200    repeat 
    201    drop 
    202  
    203    false to last-was-cr? 
    204210 
    205211   true 
     
    2112170 value telnet-ih 
    212218 
    213 defer getchar-hook  ' = to getchar-hook 
    214 patch getchar-hook =  stdin-getchar 
    215  
    216219: exit-telnet  ( -- ) 
    217    telnet-ih remove-output 
    218    telnet-ih remove-input 
    219    telnet-ih close-dev 
    220    ['] = to getchar-hook 
    221 ; 
    222  
    223 : ?telnet-closed  ( read-return 1 -- flag ) 
    224    over  -1 =  if              ( -1 1 ) 
    225       exit-telnet              ( -1 1 ) 
    226       carret pending-char c!   ( 1 1 )  
    227       ." Connection closed" \ cr 
    228       2drop true exit 
    229    then                        ( read-return 1 ) 
    230    = 
     220   telnet-ih  0=  if  exit  then 
     221 
     222   " verbose?" telnet-ih $call-method   ( verbose? ) 
     223   telnet-ih remove-output              ( verbose? ) 
     224   telnet-ih remove-input               ( verbose? ) 
     225   telnet-ih close-dev                  ( verbose? ) 
     226   0 to telnet-ih                       ( verbose? ) 
     227   if  ." telnetd: off" cr  then        ( ) 
    231228; 
    232229 
     
    239236   telnet-ih add-input 
    240237   \ hint: use " screen-ih remove-output " to speed up your telnet output 
    241    ['] ?telnet-closed to getchar-hook 
    242238; 
    243239\ LICENSE_BEGIN 
Note: See TracChangeset for help on using the changeset viewer.