Changeset 3563


Ignore:
Timestamp:
Feb 20, 2013, 3:46:23 AM (2 years 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.