Changeset 3542


Ignore:
Timestamp:
Feb 11, 2013, 5:58:33 AM (2 years 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.