--- Merging r29466 into '.':

U    utils/fppkg/lnet/ltelnet.pp
U    utils/fppkg/lnet/lcontrolstack.pp
--- Merging r29467 into '.':
U    packages/paszlib/src/zipper.pp
--- Merging r29468 into '.':
U    utils/fppkg/lnet/lftp.pp

# revisions: 29465,29466,29467,29468

git-svn-id: branches/fixes_3_0@30824 -

packages/paszlib/src/zipper.pp

@@ -33,6 +33,38 @@ Const
   CENTRAL_FILE_HEADER_SIGNATURE              = $02014B50;
   ZIP64_HEADER_ID                            = $0001;
 
+const
+  OS_FAT  = 0; //MS-DOS and OS/2 (FAT/VFAT/FAT32)
+  OS_UNIX = 3;
+  OS_OS2  = 6; //OS/2 HPFS
+  OS_NTFS = 10;
+  OS_VFAT = 14;
+  OS_OSX  = 19;
+
+  UNIX_MASK = $F000;
+  UNIX_FIFO = $1000;
+  UNIX_CHAR = $2000;
+  UNIX_DIR  = $4000;
+  UNIX_BLK  = $6000;
+  UNIX_FILE = $8000;
+  UNIX_LINK = $A000;
+  UNIX_SOCK = $C000;
+
+
+  UNIX_RUSR = $0100;
+  UNIX_WUSR = $0080;
+  UNIX_XUSR = $0040;
+
+  UNIX_RGRP = $0020;
+  UNIX_WGRP = $0010;
+  UNIX_XGRP = $0008;
+
+  UNIX_ROTH = $0004;
+  UNIX_WOTH = $0002;
+  UNIX_XOTH = $0001;
+
+  UNIX_DEFAULT = UNIX_RUSR or UNIX_WUSR or UNIX_XUSR or UNIX_RGRP or UNIX_ROTH;
+
 Type
    Local_File_Header_Type = Packed Record //1 per zipped file
      Signature              :  LongInt; //4 bytes
@@ -692,37 +724,6 @@ begin
   DT:=ComposeDateTime(EncodeDate(Y,M,D),EncodeTime(H,N,S,MS));
 end;
 
-const
-  OS_FAT  = 0; //MS-DOS and OS/2 (FAT/VFAT/FAT32)
-  OS_UNIX = 3;
-  OS_OS2  = 6; //OS/2 HPFS
-  OS_NTFS = 10;
-  OS_VFAT = 14;
-  OS_OSX  = 19;
-
-  UNIX_MASK = $F000;
-  UNIX_FIFO = $1000;
-  UNIX_CHAR = $2000;
-  UNIX_DIR  = $4000;
-  UNIX_BLK  = $6000;
-  UNIX_FILE = $8000;
-  UNIX_LINK = $A000;
-  UNIX_SOCK = $C000;
-
-
-  UNIX_RUSR = $0100;
-  UNIX_WUSR = $0080;
-  UNIX_XUSR = $0040;
-
-  UNIX_RGRP = $0020;
-  UNIX_WGRP = $0010;
-  UNIX_XGRP = $0008;
-
-  UNIX_ROTH = $0004;
-  UNIX_WOTH = $0002;
-  UNIX_XOTH = $0001;
-
-  UNIX_DEFAULT = UNIX_RUSR or UNIX_WUSR or UNIX_XUSR or UNIX_RGRP or UNIX_ROTH;
 
 
 function ZipUnixAttrsToFatAttrs(const Name: String; Attrs: Longint): Longint;
@@ -1357,17 +1358,20 @@ Begin
         Raise EZipError.CreateFmt(SErrFileDoesNotExist,[F.DiskFileName]);
       end
     else
-      begin
+    begin
       If (F.ArchiveFileName='') then
         Raise EZipError.CreateFmt(SErrMissingArchiveName,[I]);
       F.Size:=F.Stream.Size;
-    {$IFDEF UNIX}
-      F.Attributes := UNIX_FILE or UNIX_DEFAULT;
-    {$ELSE}
-      F.Attributes := faArchive;
-    {$ENDIF}
-      end;
+      if (F.Attributes = 0) then
+      begin
+      {$IFDEF UNIX}
+        F.Attributes := UNIX_FILE or UNIX_DEFAULT;
+      {$ELSE}
+        F.Attributes := faArchive;
+      {$ENDIF}
+      end;	
     end;
+  end;
 end;
 
 
@@ -2634,6 +2638,8 @@ begin
   FCompressionLevel:=cldefault;
   FDateTime:=now;
   FNeedsZip64:=false;
+  FAttributes:=0;
+
   inherited create(ACollection);
 end;
 

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.

utils/fppkg/lnet/lftp.pp

@@ -106,7 +106,7 @@ type
   
   TLFTPTelnetClient = class(TLTelnetClient)
    protected
-    procedure React(const Operation, Command: Char); override;
+    function React(const Operation, Command: Char):boolean; override;
   end;
 
   { TLFTPClient }
@@ -368,8 +368,9 @@ end;
 
 { TLFTPTelnetClient }
 
-procedure TLFTPTelnetClient.React(const Operation, Command: Char);
+function TLFTPTelnetClient.React(const Operation, Command: Char):boolean;
 begin
+  result:=false;
   // don't do a FUCK since they broke Telnet in FTP as per-usual
 end;
 

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;