Browse Source

+ Implement !proxy support for long command line
this allows passing command lines longer than 126 chars to
Free Pascal or go32v2 programs.

By default only command lines longer than 126 chars are
passed using !proxy method,
it is however possible to disable this conversion completely by
set Use_go32v2_proxy boolean variable to false (true by fdefault).
In that case, command lines longer than 126 will be truncated, but
a warning is echoed to stderr.
For testing purposes, it is possible to set the boolean variable
force_go32v2_proxy to true to force systematic use of this
conversion.

This is set by default if the RTL is compiled with
SYSTEM_DEBUG_STARTUP conditional set.

To allow use by sysutils unit, a new procedure:
exec_ansistring(path : string;comline : ansistring);

has been added to the interface, which is now called instead
of Dos.Exec from Sysutils.ExecuteProcess

git-svn-id: trunk@18159 -

pierre 14 years ago
parent
commit
1dfa5c2e74
2 changed files with 179 additions and 18 deletions
  1. 178 17
      rtl/go32v2/dos.pp
  2. 1 1
      rtl/go32v2/sysutils.pp

+ 178 - 17
rtl/go32v2/dos.pp

@@ -37,6 +37,38 @@ Type
 
 
 {$i dosh.inc}
 {$i dosh.inc}
 
 
+{$IfDef SYSTEM_DEBUG_STARTUP}
+  {$DEFINE FORCE_PROXY}
+{$endif SYSTEM_DEBUG_STARTUP}
+Const
+  { This variable can be set to true
+    to force use of !proxy command lines even for short
+    strings, for debugging purposes mainly, as
+    this might have negative impact if trying to
+    call non-go32v2 programs }
+  force_go32v2_proxy : boolean =
+{$ifdef FORCE_PROXY}
+  true;
+{$DEFINE DEBUG_PROXY}
+{$else not FORCE_PROXY}
+  false;
+{$endif not FORCE_PROXY}
+  { This variable allows to use !proxy if command line is
+    longer than 126 characters.
+    This will only work if the called program knows how to handle
+    those command lines.
+    Luckily this is the case for Free Pascal compiled
+    programs (even old versions)
+    and go32v2 DJGPP programs.
+    You can set this to false to get a warning to stderr
+    if command line is too long. }
+  Use_go32v2_proxy : boolean = true;
+
+{ Added to interface so that there is no need to implement it
+  both in dos and sysutils units }
+
+procedure exec_ansistring(path : string;comline : ansistring);
+
 implementation
 implementation
 
 
 uses
 uses
@@ -165,7 +197,7 @@ end;
 const
 const
   DOS_MAX_COMMAND_LINE_LENGTH = 126;
   DOS_MAX_COMMAND_LINE_LENGTH = 126;
 
 
-procedure exec(const path : pathstr;const comline : comstr);
+procedure exec_ansistring(path : string;comline : ansistring);
 type
 type
   realptr = packed record
   realptr = packed record
     ofs,seg : word;
     ofs,seg : word;
@@ -184,23 +216,30 @@ var
   i,la_env,
   i,la_env,
   la_p,la_c,la_e,
   la_p,la_c,la_e,
   fcb1_la,fcb2_la : longint;
   fcb1_la,fcb2_la : longint;
+  use_proxy       : boolean;
+  proxy_argc      : longint;
   execblock       : texecblock;
   execblock       : texecblock;
-  c,p             : string;
+  c               : ansistring;
+  p               : string;
 
 
-  function paste_to_dos(src : string;cr : boolean; n : longint) : boolean;
+  function paste_to_dos(src : string;add_cr_at_end, include_string_length : boolean) : boolean;
   {Changed by Laaca - added parameter N}
   {Changed by Laaca - added parameter N}
   var
   var
     c : pchar;
     c : pchar;
     CLen : cardinal;
     CLen : cardinal;
-    ls : longint;
+    start_pos,ls : longint;
   begin
   begin
      paste_to_dos:=false;
      paste_to_dos:=false;
-     ls:=Length(src)-n;
+     if include_string_length then
+       start_pos:=0
+     else
+       start_pos:=1;
+     ls:=Length(src)-start_pos;
      if current_dos_buffer_pos+ls+3>transfer_buffer+tb_size then
      if current_dos_buffer_pos+ls+3>transfer_buffer+tb_size then
       RunError(217);
       RunError(217);
      getmem(c,ls+3);
      getmem(c,ls+3);
-     move(src[n],c^,ls+1);
-     if cr then
+     move(src[start_pos],c^,ls+1);
+     if add_cr_at_end then
       begin
       begin
         c[ls+1]:=#13;
         c[ls+1]:=#13;
         c[ls+2]:=#0;
         c[ls+2]:=#0;
@@ -214,17 +253,120 @@ var
      paste_to_dos:=true;
      paste_to_dos:=true;
   end;
   end;
 
 
+  procedure setup_proxy_cmdline;
+  const
+    MAX_ARGS = 128;
+  var
+    i : longint;
+    quote : char;
+    end_of_arg, skip_char : boolean;
+    la_proxy_seg    : word;
+    la_proxy_ofs    : longint;
+    current_arg : string;
+    la_argv_ofs : array [0..MAX_ARGS] of word;
+  begin
+    quote:=#0;
+    current_arg:='';
+    proxy_argc:=0;
+    end_of_arg:=false;
+    while current_dos_buffer_pos mod 16 <> 0 do
+      inc(current_dos_buffer_pos);
+    la_proxy_seg:=current_dos_buffer_pos shr 4;
+    { Also copy parameter 0 }
+    la_argv_ofs[0]:=current_dos_buffer_pos-la_proxy_seg*16;
+    { Note that this should be done before
+      alteriing p value }
+    paste_to_dos(p,false,false);
+    inc(proxy_argc);
+    for i:=1 to length(c) do
+      begin
+        skip_char:=false;
+        case c[i] of
+          #1..#32:
+            begin
+              if quote=#0 then
+                end_of_arg:=true;
+            end;
+          '"' :
+            begin
+              if quote=#0 then
+                begin
+                  quote:='"';
+                  skip_char:=true;
+                end
+              else if quote='"' then
+                end_of_arg:=true;
+            end;
+          '''' :
+            begin
+              if quote=#0 then
+                begin
+                  quote:='''';
+                  skip_char:=true;
+                end
+              else if quote='''' then
+                end_of_arg:=true;
+            end;
+        end;
+        if not end_of_arg and not skip_char then
+          current_arg:=current_arg+c[i];
+        if i=length(c) then
+          end_of_arg:=true;
+        if end_of_arg and (current_arg<>'') then
+          begin
+            if proxy_argc>MAX_ARGS then
+              begin
+                writeln(stderr,'Too many arguments in Dos.exec');
+                RunError(217);
+              end;
+            la_argv_ofs[proxy_argc]:=current_dos_buffer_pos-la_proxy_seg*16;
+{$ifdef DEBUG_PROXY}
+            writeln(stderr,'arg ',proxy_argc,'="',current_arg,'"');
+{$endif DEBUG_PROXY}
+            paste_to_dos(current_arg,false,false);
+            inc(proxy_argc);
+            quote:=#0;
+            current_arg:='';
+            end_of_arg:=false;
+          end;
+      end;
+    la_proxy_ofs:=current_dos_buffer_pos - la_proxy_seg*16;
+    seg_move(get_ds,longint(@la_argv_ofs),dosmemselector,
+             current_dos_buffer_pos,proxy_argc*sizeof(word));
+    current_dos_buffer_pos:=current_dos_buffer_pos + proxy_argc*sizeof(word);
+    c:='!proxy '+hexstr(proxy_argc,4)+' '+hexstr(la_proxy_seg,4)
+       +' '+hexstr(la_proxy_ofs,4);
+{$ifdef DEBUG_PROXY}
+    writeln(stderr,'Using comline "',c,'"');
+{$endif DEBUG_PROXY}
+  end;
+
+
 begin
 begin
 { create command line }
 { create command line }
   c:=comline;
   c:=comline;
-  if length(c)>DOS_MAX_COMMAND_LINE_LENGTH then
-    c[0]:=chr(DOS_MAX_COMMAND_LINE_LENGTH);
+  if force_go32v2_proxy then
+    Use_proxy:=true
+  else if length(c)>DOS_MAX_COMMAND_LINE_LENGTH then
+    begin
+      if Use_go32v2_proxy then
+        begin
+          Use_Proxy:=true;
+        end
+      else
+        begin
+           writeln(stderr,'Dos.exec command line truncated to ',
+                   DOS_MAX_COMMAND_LINE_LENGTH,' chars');
+           writeln(stderr,'Before: "',c,'"');
+           setlength(c, DOS_MAX_COMMAND_LINE_LENGTH);
+           writeln(stderr,'After: "',c,'"');
+         end;
+    end;
 { create path }
 { create path }
+{$ifdef DEBUG_PROXY}
+  writeln(stderr,'Dos.exec path="',path,'"');
+{$endif DEBUG_PROXY}
   p:=path;
   p:=path;
-{ allow slash as backslash }
-  DoDirSeparators(p);
-  if LFNSupport then
-    GetShortName(p);
 { create buffer }
 { create buffer }
   la_env:=transfer_buffer;
   la_env:=transfer_buffer;
   while (la_env and 15)<>0 do
   while (la_env and 15)<>0 do
@@ -232,13 +374,24 @@ begin
   current_dos_buffer_pos:=la_env;
   current_dos_buffer_pos:=la_env;
 { copy environment }
 { copy environment }
   for i:=1 to envcount do
   for i:=1 to envcount do
-   paste_to_dos(envstr(i),false,1);
+   paste_to_dos(envstr(i),false,false);
   {the behaviour is still suboptimal because variable COMMAND is stripped out}
   {the behaviour is still suboptimal because variable COMMAND is stripped out}
-  paste_to_dos(chr(0),false,1); { adds a double zero at the end }
+  paste_to_dos(chr(0),false,false); { adds a double zero at the end }
+  if use_proxy then
+    setup_proxy_cmdline;
+{ allow slash as backslash }
+  DoDirSeparators(p);
+  if LFNSupport then
+    GetShortName(p);
+  { Add program to DosBuffer with
+    length at start }
   la_p:=current_dos_buffer_pos;
   la_p:=current_dos_buffer_pos;
-  paste_to_dos(p,false,0);
+  paste_to_dos(p,false,true);
+  { Add command line args to DosBuffer with
+    length at start and Carriage Return at end }
   la_c:=current_dos_buffer_pos;
   la_c:=current_dos_buffer_pos;
-  paste_to_dos(c,true,0);
+  paste_to_dos(c,true,true);
+
   la_e:=current_dos_buffer_pos;
   la_e:=current_dos_buffer_pos;
   fcb1_la:=la_e;
   fcb1_la:=la_e;
   la_e:=la_e+16;
   la_e:=la_e+16;
@@ -261,6 +414,9 @@ begin
   dosregs.esi:=(la_c+arg_ofs) and 15;
   dosregs.esi:=(la_c+arg_ofs) and 15;
   dosregs.es:=fcb2_la shr 4;
   dosregs.es:=fcb2_la shr 4;
   dosregs.edi:=fcb2_la and 15;
   dosregs.edi:=fcb2_la and 15;
+{$ifdef DEBUG_PROXY}
+  flush(stderr);
+{$endif DEBUG_PROXY}
   msdos(dosregs);
   msdos(dosregs);
   with execblock do
   with execblock do
    begin
    begin
@@ -290,6 +446,11 @@ begin
    LastDosExitCode:=0;
    LastDosExitCode:=0;
 end;
 end;
 
 
+procedure exec(const path : pathstr;const comline : comstr);
+begin
+  exec_ansistring(path, comline);
+end;
+
 
 
 procedure getcbreak(var breakvalue : boolean);
 procedure getcbreak(var breakvalue : boolean);
 begin
 begin

+ 1 - 1
rtl/go32v2/sysutils.pp

@@ -782,7 +782,7 @@ var
   CommandLine: AnsiString;
   CommandLine: AnsiString;
 
 
 begin
 begin
-  dos.exec(path,comline);
+  dos.exec_ansistring(path,comline);
 
 
   if (Dos.DosError <> 0) then
   if (Dos.DosError <> 0) then
     begin
     begin