! rlogin program for (interim) Mouse

%option "-NonStandard-NoCheck-NoDiag-NoLine"

%constinteger rlogin port = 513

%include "Moose:Mouse.Inc"
%include "INet:INet.Inc"

%include "INet:INetAddrs"

%externalpredicatespec FS lookup(%string(31) what, %integername value)
%externalpredicatespec authority identify user(%integer token, %string(*)%name user)

%constinteger CR = 13, LF = 10

%constinteger no echo = 1, no term echo = 2, single = 4, no page = 8, frozen = 16
%externalintegerspec terminal mode
%owninteger saved terminal mode = 0
%externalintegerfnspec test symbol

!! %routine print INet address(%integer addr)
!!    write(addr >> 24 & 255, 0);  print symbol('.')
!!    write(addr >> 16 & 255, 0);  print symbol('.')
!!    write(addr >>  8 & 255, 0);  print symbol('.')
!!    write(addr       & 255, 0)
!! %end

%ownrecord(semaphore fm) RX semaphore = 0
%ownrecord(mailbox fm) RX mailbox = 0
%ownrecord(INet user request fm) RX request = 0

%ownrecord(semaphore fm) TX semaphore = 0
%ownrecord(mailbox fm) TX mailbox = 0
%ownrecord(INet user request fm) TX request = 0

%ownrecord(mailbox fm)%name INet mailbox

%owninteger unit = 0
%owninteger key = 0

%routine close
   %record(INet user request fm)%name reply
      !! printstring("Closing...");  newline
      TX request_unit = unit
      TX request_key = key
      TX request_code = TCP close request
      send message(TX request, INet mailbox, TX mailbox)
      !! printstring("Sent request, awaiting reply");  newline
      reply == receive message(TX mailbox)
      !! printstring("Reply received: ")
      !! printstring(INet errors(reply_status));  newline
%end

%routine check(%integer status)
   %return %if status = 0
   terminal mode = saved terminal mode
   newline
   %if status = closing error %start
      !! printstring("Close received");  newline
      close
      %stop
   %finish
   printstring("rlogin: ")
   %if closing error <= status <= dud op error %start
      printstring(INet errors(status))
   %else
      write(status, 0)
   %finish
   newline
   %stop %if key = 0;  ! Not connected yet
   TX request_unit = unit
   TX request_key = key
   TX request_code = TCP abort request
   send message(TX request, INet mailbox, nil)
   %stop
%end

%routine connect(%integer peer)
   %recordformat connect fm(%integer ra, rp, lp, mss)
   %record(connect fm) c
   %record(INet user request fm)%name reply
      key = addr(TX request)
      TX request_key = key
      TX request_code = TCP allocate unit request
      send message(TX request, INet mailbox, TX mailbox)
      reply == receive message(TX mailbox)
      check(reply_status)
      unit = reply_unit
      !! printstring("Allocated unit ");  write(unit, 0);  newline
      TX request_unit = unit
      TX request_key = key
      TX request_code = TCP claim priv request
      TX request_buffer == byteinteger(addr(c_lp))
      send message(TX request, INet mailbox, TX mailbox)
      reply == receive message(TX mailbox)
      check(reply_status)
      !! printstring("Allocated port ");  write(c_lp, 0);  newline
      c_ra = peer;  c_rp = rlogin port
      c_mss = 480
      TX request_unit = unit
      TX request_key = key
      TX request_code = TCP open request
      TX request_buffer == byteinteger(addr(c))
      TX request_bytes = 16
      send message(TX request, INet mailbox, TX mailbox)
      reply == receive message(TX mailbox)
      check(reply_status)
      !! printstring("Connected");  newline
%end

%routine send info(%string(31) local, remote)
   %record(INet user request fm)%name reply
   %string(255) text
      text = to string(0) . local . to string(0) . remote . %c
             to string(0) . "vt100/9600" . to string(0)
      TX request_unit = unit
      TX request_key = key
      TX request_code = TCP send request
      TX request_buffer == charno(text, 1)
      TX request_bytes = length(text)
      !! printstring("Text at ");  phex(addr(TX request_bytes));  newline
      send message(TX request, INet mailbox, TX mailbox)
      reply == receive message(TX mailbox)
      check(reply_status)
      !! printstring("Sent connect data");  newline
%end

%routine loop
   %bytearray RX buffer(1 : 2048)
   %record(INet user request fm)%name reply
   %integer char, Y count = 0, i
      !! printstring("""Looping""");  newline
      RX request_unit = unit
      RX request_key = key
      RX request_timeout = 0
      RX request_code = TCP receive request
      RX request_buffer == RX buffer(1)
      send message(RX request, INet mailbox, RX mailbox)
      %cycle
         ! Keyboard input?
         char = test symbol
         %if char >= 0 %start
            %if char = 'Y' - '@' %or char = 'C' - '@' %start
               !! print symbol('^');  print symbol(char + '@')
               Y count = Y count + 1
               check(-98) %if Y count = 5
            %else %if char = CR
               char = LF
               Y count = 0
            %else %if char = LF
               char = CR
               Y count = 0
            %else
               Y count = 0
            %finish
            TX request_unit = unit
            TX request_key = key
            TX request_code = TCP send request
            TX request_buffer == byteinteger(addr(char) + 3)
            TX request_bytes = 1
            send message(TX request, INet mailbox, TX mailbox)
            reply == receive message(TX mailbox)
            check(reply_status)
         %finish
         ! Data from the other end?
         reply == dequeue(RX mailbox_queue)
         %if reply ## nil %start
            semaphore wait(RX semaphore)
            check(reply_status)
            print symbol(RX buffer(i)) %for i = 1, 1, reply_bytes
            RX request_unit = unit
            RX request_key = key
            RX request_timeout = 0
            RX request_code = TCP receive request
            RX request_buffer == RX buffer(1)
            send message(RX request, INet mailbox, RX mailbox)
         %finish
      %repeat
%end 


%begin
   %string(127) target, user
   %integer x
      %if FS lookup(INet mailbox name, x) %start
         INet mailbox == record(x)
      %else
         printstring("No INet mailbox");  newline
         %stop
      %finish
      %unless authority identify user(0, user) %start
         printstring("Dud user token");  newline
         %stop
      %finish
      to lower(user)
      target = CLI param
      %while target = "" %cycle
         prompt("Target: ")
         read(target)
      %repeat
      x = INet name to address(target)
      %if x = 0 %start
         printstring(target);  printstring(" unknown")
         newline
         %stop
      %finish
      !! printstring(target);  printstring(" is at ")
      !! print INet address(x);  newline
      setup semaphore(RX semaphore)
      setup mailbox(RX mailbox, RX semaphore)
      setup message(RX request, size of(RX request))
      setup semaphore(TX semaphore)
      setup mailbox(TX mailbox, TX semaphore)
      setup message(TX request, size of(TX request))
      saved terminal mode = terminal mode
      !! printstring("Saved terminal mode: ");  phex(saved terminal mode);  newline
      connect(x)
      send info(user, user)
      terminal mode = no page ! no echo ! single
      loop
%end %of %program