* ltelnet subcommand first character improvements. Mantis #27273

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@29466 3ad0048d-3df7-0310-abae-a5850022a9f2

2 files changed, 113 insertions, 33 deletions

diff --git a/utils/fppkg/lnet/lcontrolstack.pp b/utils/fppkg/lnet/lcontrolstack.pp
index 7c9bf4aa72..eef0ac8630 100644
--- a/utils/fppkg/lnet/lcontrolstack.pp
+++ b/utils/fppkg/lnet/lcontrolstack.pp
@@ -37,15 +37,18 @@ type
    private
     FItems: array of Char;
     FIndex: Byte;
+    FAllowInflation: Boolean;
     FOnFull: TLOnFull;
     function GetFull: Boolean;
     function GetItem(const i: Byte): Char;
     procedure SetItem(const i: Byte; const Value: Char);
+    procedure SetAllowInflation(const b: boolean);
    public
     constructor Create;
     procedure Clear;
     procedure Push(const Value: Char);
     property ItemIndex: Byte read FIndex;
+    property AllowInflation: Boolean read FAllowInflation write SetAllowInflation;
     property Items[i: Byte]: Char read GetItem write SetItem; default;
     property Full: Boolean read GetFull;
     property OnFull: TLOnFull read FOnFull write FOnFull;
@@ -55,47 +58,80 @@ implementation
 
 uses
   lTelnet;
+
+(* The normal situation is that there are up to TL_CSLENGTH items on the stack. *)
+(* However this may be relaxed in cases (assumed to be rare) where subcommand   *)
+(* parameters are being accumulated.                                            *)
   
 constructor TLControlStack.Create;
 begin
   FOnFull:=nil;
-  FIndex:=0;
+  FIndex:=0;                            (* Next insertion point, [0] when empty *)
+  FAllowInflation := false;
   SetLength(FItems, TL_CSLENGTH);
 end;
 
 function TLControlStack.GetFull: Boolean;
 begin
-  Result:=False;
-  if FIndex >= TL_CSLENGTH then
-    Result:=True;
+  Result:=False;                        (* It's full when it has a complete     *)
+  if FIndex >= TL_CSLENGTH then         (* command, irrespective of whether the *)
+    Result:=True;                       (* stack's inflated by a subcommand.    *)
 end;
 
 function TLControlStack.GetItem(const i: Byte): Char;
 begin
   Result:=TS_NOP;
-  if i < TL_CSLENGTH then
-    Result:=FItems[i];
+  if not FAllowInflation then begin
+    if i < TL_CSLENGTH then
+      Result:=FItems[i]
+  end else
+    if i < Length(FItems) then
+      Result:=FItems[i]
 end;
 
 procedure TLControlStack.SetItem(const i: Byte; const Value: Char);
 begin
-  if i < TL_CSLENGTH then
-    FItems[i]:=Value;
+  if not FAllowInflation then begin
+    if i < TL_CSLENGTH then
+      FItems[i]:=Value
+  end else begin
+    while i >= Length(FItems) do begin
+      SetLength(FItems, Length(FItems) + 1);
+      FItems[Length(FItems) - 1] := TS_NOP
+    end;
+    FItems[i] := Value
+  end
+end;
+
+procedure TLControlStack.SetAllowInflation(const b: boolean);
+
+begin
+  FAllowInflation := b;
+  if not b then                         (* No more funny stuff please           *)
+    Clear
 end;
 
 procedure TLControlStack.Clear;
 begin
   FIndex:=0;
+  FAllowInflation := false;
+  SetLength(FItems, TL_CSLENGTH)        (* In case inflation was allowed        *)
 end;
 
 procedure TLControlStack.Push(const Value: Char);
 begin
-  if FIndex < TL_CSLENGTH then begin
-    FItems[FIndex]:=Value;
-    Inc(FIndex);
-    if Full and Assigned(FOnFull) then
-      FOnFull;
+  if not FAllowInflation then
+    if FIndex < TL_CSLENGTH then begin
+      FItems[FIndex]:=Value;
+      Inc(FIndex)
+    end else begin end
+  else begin
+    SetLength(FItems, Length(FItems) + 1);
+    FItems[Length(FItems) - 1] := Value;
+    FIndex := Length(FItems)
   end;
+  if Full and Assigned(FOnFull) then
+    FOnFull;
 end;
 
 end.
diff --git a/utils/fppkg/lnet/ltelnet.pp b/utils/fppkg/lnet/ltelnet.pp
index 190995d7b8..6ab7881d3a 100644
--- a/utils/fppkg/lnet/ltelnet.pp
+++ b/utils/fppkg/lnet/ltelnet.pp
@@ -27,7 +27,7 @@ unit lTelnet;
 interface
 
 uses
-  Classes, lNet, lControlStack;
+  Classes, SysUtils, lNet, lControlStack;
   
 const
   // Telnet printer signals
@@ -72,9 +72,11 @@ type
   TLSubcommandCallback= function(command: char; const parameters, defaultResponse: string): string;
   TLSubcommandEntry= record
                        callback: TLSubcommandCallback;
-                       defaultResponse: string
+                       defaultResponse: string;
+                       requiredParams: integer
                      end;
   TLSubcommandArray= array[#$00..#$ff] of TLSubcommandEntry;
+  EInsufficientSubcommandParameters= class(Exception);
 
   { TLTelnet }
 
@@ -117,7 +119,7 @@ type
     procedure StackFull;
     procedure DoubleIAC(var s: string);
     function TelnetParse(const msg: string): Integer;
-    procedure React(const Operation, Command: Char); virtual; abstract;
+    function React(const Operation, Command: Char): boolean; virtual; abstract;
     procedure SendCommand(const Command: Char; const Value: Boolean); virtual; abstract;
 
     procedure OnCs(aSocket: TLSocket);
@@ -136,7 +138,8 @@ type
     procedure SetOption(const Option: Char);
     procedure UnSetOption(const Option: Char);
 
-    function RegisterSubcommand(aOption: char; callback: TLSubcommandCallback; const defaultResponse: string= ''): boolean;
+    function RegisterSubcommand(aOption: char; callback: TLSubcommandCallback;
+                const defaultResponse: string= ''; requiredParams: integer= 0): boolean;
 
     procedure Disconnect(const Forced: Boolean = True); override;
     
@@ -164,7 +167,7 @@ type
     procedure OnRe(aSocket: TLSocket);
     procedure OnCo(aSocket: TLSocket);
 
-    procedure React(const Operation, Command: Char); override;
+    function React(const Operation, Command: Char): boolean; override;
     
     procedure SendCommand(const Command: Char; const Value: Boolean); override;
    public
@@ -190,7 +193,9 @@ function LTelnetSubcommandCallback(command: char; const parameters, defaultRespo
 implementation
 
 uses
-  SysUtils, Math;
+  Math;
+
+const   subcommandEndLength= 2;
 
 var
   zz: Char;
@@ -306,8 +311,10 @@ begin
     begin
       FOutput.WriteByte(Byte(FStack[1]));
       FOutput.WriteByte(Byte(FStack[2]));
-    end else React(FStack[1], FStack[2]);
-  FStack.Clear;
+      FStack.Clear
+    end else
+      if React(FStack[1], FStack[2]) then
+        FStack.Clear
 end;
 
 procedure TLTelnet.DoubleIAC(var s: string);
@@ -394,15 +401,22 @@ end;
 
 (* If already set, the callback can be reverted to nil but it can't be changed  *)
 (* in a single step. The default response, if specified, is used by the         *)
-(* LTelnetSubcommandCallback() function and is available to others.             *)
+(* LTelnetSubcommandCallback() function and is available to others; the         *)
+(* callback will not be invoked until there is at least the indicated number of *)
+(* parameter bytes available.                                                   *)
 //
-function TLTelnet.RegisterSubcommand(aOption: char; callback: TLSubcommandCallback; const defaultResponse: string= ''): boolean;
+function TLTelnet.RegisterSubcommand(aOption: char; callback: TLSubcommandCallback;
+            const defaultResponse: string= ''; requiredParams: integer= 0): boolean;
 
 begin
   result := (not Assigned(FSubcommandCallbacks[aOption].callback)) or (@callback = nil);
   if result then begin
     FSubcommandCallbacks[aOption].callback := callback;
-    FSubcommandCallbacks[aOption].defaultResponse := defaultResponse
+    FSubcommandCallbacks[aOption].defaultResponse := defaultResponse;
+    Inc(requiredParams, subcommandEndLength);
+    if requiredParams < 0 then          (* Assume -subcommandEndLength is a     *)
+      requiredParams := 0;              (* valid parameter.                     *)
+    FSubcommandCallbacks[aOption].requiredParams := requiredParams;
   end
 end { TLTelnet.RegisterSubcommand } ;
 
@@ -464,7 +478,7 @@ begin
     FOnConnect(aSocket);
 end;
 
-procedure TLTelnetClient.React(const Operation, Command: Char);
+function TLTelnetClient.React(const Operation, Command: Char): boolean;
 
   procedure Accept(const Operation, Command: Char);
   begin
@@ -487,17 +501,28 @@ procedure TLTelnetClient.React(const Operation, Command: Char);
   end;
 
 (* Retrieve the parameters from the current instance, and pass them explicitly  *)
-(* to the callback.                                                             *)
+(* to the callback. Return false if there are insufficient parameters on the    *)
+(* stack.                                                                       *)
 //
-  procedure subcommand(command: char);
+  function subcommand(command: char): boolean;
 
   var   parameters, response: string;
         i: integer;
 
   begin
-    if FStack.ItemIndex > 5 then begin
-      SetLength(parameters, FStack.ItemIndex - 5);
-      Move(FStack[3], parameters[1], FStack.ItemIndex - 5);
+    FStack.AllowInflation := true;      (* We might need more than the standard *)
+    if FStack.ItemIndex > 65536 then    (* command, but protect against parse   *)
+      {%H- 6018 } exit(true);           (* failure which could be a DoS attack. *)
+    i := FStack.ItemIndex - TL_CSLENGTH; (* Number of parameter bytes available.*)
+    if i < FSubcommandCallbacks[command].requiredParams then
+      exit(false);                      (* Early insufficient-parameters decision *)
+    result := true;
+    if FStack.ItemIndex > TL_CSLENGTH then begin
+      SetLength(parameters, FStack.ItemIndex - TL_CSLENGTH );
+      Move(FStack[3], parameters[1], FStack.ItemIndex - TL_CSLENGTH );
+      if (Length(parameters) >= 2) and (parameters[Length(parameters)] = TS_IAC) and
+                                (parameters[Length(parameters) - 1] <> TS_IAC) then
+        exit(false);                    (* Special case: need at least one more *)
       i := 1;
       while i <= Length(parameters) - 1 do      (* Undouble IACs                *)
         if (parameters[i] = TS_IAC) and (parameters[i + 1] = TS_IAC) then
@@ -506,13 +531,27 @@ procedure TLTelnetClient.React(const Operation, Command: Char);
           Inc(i)
     end else
       parameters := '';
-    response := FSubcommandCallbacks[command].callback(command, parameters, FSubcommandCallbacks[command].defaultResponse);
+    if Length(parameters) < FSubcommandCallbacks[command].requiredParams then
+      exit(false);                      (* Insufficient params after IAC undouble *)
+    if (FSubcommandCallbacks[command].requiredParams >= subcommandEndLength) and
+                                (Length(parameters) >= subcommandEndLength) then
+      SetLength(parameters, Length(parameters) - subcommandEndLength);
+    try
+      response := FSubcommandCallbacks[command].callback(command, parameters,
+                                FSubcommandCallbacks[command].defaultResponse)
+    except
+      on e: EInsufficientSubcommandParameters do
+        Exit(false)                     (* Late insufficient-parameters decision *)
+      else
+        Raise                           (* Application-specific error           *)
+    end;
     DoubleIAC(response);
     AddToBuffer(TS_IAC + TS_SB + command + response + TS_IAC + TS_SE);
     OnCs(nil)
   end { subcommand } ;
 
 begin
+  result := true;                       (* Stack will normally be cleared       *)
   {$ifdef debug}
   Writeln('**GOT** ', TNames[Operation], ' ', TNames[Command]);
   {$endif}
@@ -529,7 +568,12 @@ begin
     TS_SB   : if not Assigned(FSubcommandCallbacks[command].callback) then
                 refuse(TS_WONT, command)
               else
-                subcommand(command)
+                result := subcommand(command)
+
+(* In the final case above, the stack will not be cleared if sufficient         *)
+(* parameters to keep the subcommand happy have not yet been parsed out of the  *)
+(* message.                                                                     *)
+
   end;
 end;
 
@@ -559,7 +603,7 @@ end;
 
 function TLTelnetClient.Get(out aData; const aSize: Integer; aSocket: TLSocket): Integer;
 begin
-  Result := FOutput.Read(aData, aSize);
+  Result := FOutput.Read(aData {%H- 5058 } , aSize);
   if FOutput.Position = FOutput.Size then
     FOutput.Clear;
 end;