Changeset 3563


Ignore:
Timestamp:
Feb 20, 2013, 3:46:23 AM (14 months ago)
Author:
quozl
Message:

inet - add remote diagnosis console feature, increase verbosity of telnet and telnetd, include telnetd in build rather than autoload from source, and allow other port numbers for outbound telnet.

Location:
ofw/inet
Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed
  • ofw/inet/loadtcp.fth

    r1 r3563  
    2121fload ${BP}/ofw/inet/telnet.fth 
    2222fload ${BP}/ofw/inet/loadmail.fth 
    23  
    24 warning @ warning off 
    25 autoload: telnetd  defines: telnetd 
    26 warning ! 
     23fload ${BP}/ofw/inet/telnetd.fth 
     24fload ${BP}/ofw/inet/rdc.fth 
    2725 
    2826also forth definitions 
  • ofw/inet/telnet.fth

    r1 r3563  
    112112   repeat 
    113113; 
    114 : $telnet  ( hostname$ -- )  d# 23  open-tcp-connection  (telnet)  close-tcp  ; 
    115 : telnet  ( "hostname" -- )  safe-parse-word $telnet  ; 
     114: $telnet  ( host$ port# -- ) 
     115   open-tcp-connection 
     116   ." telnet: connected" cr 
     117   (telnet) 
     118   close-tcp 
     119   ." telnet: disconnected" cr 
     120; 
     121: telnet  ( "host" ["port"] -- ) 
     122   safe-parse-word                                      ( host$ ) 
     123   parse-word dup if                                    ( host$ port$ ) 
     124      push-decimal $number pop-base abort" Bad port"    ( host$ port# ) 
     125   else 
     126      2drop d# 23 
     127   then                                                 ( host$ port# ) 
     128   $telnet 
     129; 
    116130 
    117131hex 
  • ofw/inet/telnetd.fth

    r3542 r3563  
    66\ When done, execute "exit-telnet" or just close the connection. 
    77 
     8\needs telnet fload ${BP}/ofw/inet/telnet.fth \ for protocol constants 
     9 
    810support-package: telnet 
    9 false value debug-options? 
     11false value debug-options?      \ display telnet option negotiation 
    1012false value verbose? 
    11 false value listening? 
     13false value passive?            \ package is not to try accept or connect 
     14false value listening?          \ package is to try accept 
    1215 
    1316: (read)  ( adr len -- actual )  " read" $call-parent  ; 
     
    5053 
    5154: send-option  ( option request -- )  #iac putbyte  putbyte  putbyte  ; 
    52 : send-will    ( option -- )   " WILL" .sent  d# 251 send-option  ; 
    53 : send-wont    ( option -- )   " WONT" .sent  d# 252 send-option  ; 
    54 : send-do      ( option -- )   " DO"   .sent  d# 253 send-option  ; 
    55 : send-dont    ( option -- )   " DONT" .sent  d# 254 send-option  ; 
     55: send-will    ( option -- )   " WILL" .sent  #will send-option  ; 
     56: send-wont    ( option -- )   " WONT" .sent  #wont send-option  ; 
     57: send-do      ( option -- )   " DO"   .sent  #do  send-option  ; 
     58: send-dont    ( option -- )   " DONT" .sent  #dont send-option  ; 
    5659 
    5760: will  ( rem$ -- rem$' ) 
     
    6063\ Since we have already sent "do binary", there is no need to re-ack it 
    6164\     0  of  send-do   endof 
    62       0  of  drop      endof    \ Suppress go-ahead 
     65      0  of  drop      endof    \ Suppress binary 
    6366 
    6467\ Since we have already sent "do suppressGA", there is no need to re-ack it 
     
    121124      d# 248  of  control u reinsert   endof    \ erase line 
    122125      d# 249  of                       endof    \ go-ahead 
    123       d# 250  of  subnegotiate         endof 
    124       d# 251  of  will                 endof 
    125       d# 252  of  wont                 endof 
    126       d# 253  of  tdo                  endof 
    127       d# 254  of  dont                 endof 
     126      #sb     of  subnegotiate         endof 
     127      #will   of  will                 endof 
     128      #wont   of  wont                 endof 
     129      #do     of  tdo                  endof 
     130      #dont   of  dont                 endof 
    128131      #iac    of  #iac reinsert        endof 
    129132   endcase 
     
    156159; 
    157160 
    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  
     161: negotiate  ( -- ) 
    163162   3 send-do            \ You suppress go-ahead 
    164163   0 send-do            \ Be binary 
    165164   1 send-will          \ I will echo 
     165; 
     166 
     167: accept?  ( -- connected? ) 
     168   d# 23 " accept" $call-parent  0=  if  false exit  then 
     169 
     170   verbose?  if  ." telnetd: connection from "  .his-ip-addr cr  then 
     171   negotiate 
     172   false to listening? 
     173   false to last-was-cr? 
     174   true 
     175; 
     176 
     177: connect?  ( $host port# -- connected? ) 
     178   >r " $set-host" $call-parent r> ( port ) 
     179   " connect" $call-parent  0=  if  false exit  then ( ) 
     180 
     181   negotiate 
    166182   false to listening? 
    167183   false to last-was-cr? 
     
    176192 
    177193: read  ( adr len -- actual|-1|-2 ) 
    178    listening?  if  accept? drop  2drop  -2  exit  then 
     194   listening?  passive?  0=  and  if  accept? drop  2drop  -2  exit  then 
    179195   over swap  (read)                            ( adr actual ) 
    180196   dup case                                     ( adr actual ) 
     
    197213; 
    198214 
     215: parse-args  ( $ -- ) 
     216   begin  ?dup  while 
     217      ascii , left-parse-string 
     218      2dup " verbose" $=  if  true to verbose?  then 
     219           " passive" $=  if  true to passive?  then 
     220   repeat drop 
     221; 
     222 
    199223: open  ( -- flag ) 
    200224   true to listening? 
    201    my-args " verbose" $=  to verbose? 
     225   my-args parse-args 
     226   passive?  if  true exit  then 
    202227 
    203228   verbose?  if 
     
    207232   begin  accept?  until 
    208233 
    209    verbose?  if  ." Connected" cr  then 
    210  
    211234   true 
    212235; 
     
    214237end-support-package 
    215238 
    216  
    2172390 value telnet-ih 
     240 
     241: mux    ( -- )  telnet-ih " add-console"    evaluate  ; 
     242: demux  ( -- )  telnet-ih " remove-console" evaluate  ; 
     243 
     244: open-telnet  ( name$ -- ) 
     245   open-dev dup 0= abort" Can't open telnet"  ( ih ) 
     246   to telnet-ih 
     247; 
     248 
     249: close-telnet 
     250   telnet-ih close-dev 
     251   0 to telnet-ih 
     252; 
    218253 
    219254: exit-telnet  ( -- ) 
     
    221256 
    222257   " 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? ) 
     258   demux 
     259   close-telnet                         ( verbose? ) 
    227260   if  ." telnetd: off" cr  then        ( ) 
    228261; 
    229262 
    230 devalias telnetd  tcp//telnet:verbose 
    231  
    232263: telnetd  ( -- ) 
    233    " telnetd" open-dev dup 0= abort" Can't open telnet"  ( ih ) 
    234    to telnet-ih 
    235    telnet-ih add-output 
    236    telnet-ih add-input 
    237    \ hint: use " screen-ih remove-output " to speed up your telnet output 
    238 ; 
     264   " tcp//telnet:verbose" open-telnet  mux  banner 
     265; 
     266 
    239267\ LICENSE_BEGIN 
    240268\ Copyright (c) 2006 FirmWorks 
Note: See TracChangeset for help on using the changeset viewer.