瀏覽代碼

* moved maybequoted() from cutils to cfileutl and let its behaviour vary
based on the actual target platform rather than always on the host
platform
* on Unix, use single rather than double quotes for quoting, so it also
properly handles $, ! and `, which keep their special meaning when
appearing in scripts inside double quotes
* since sysutils.executeprocess() can only deal with double-quoted
strings in parameters, re-quote parameters on Unix when they turn
out not to be for scripts but for direct execution (which is most
of the time, but unfortunately doing the reverse is not possible
because parameters used in scripts sometimes contain script-specific
code that must not be quoted, such as `cat link.res`)
-> always use cfileutl.RequotedExecuteProcess() rather than
sysutils.ExecuteProcess() in the compiler (added a bunch of dummy
ExecuteProcess string constants to common units to prevent accidental
usage)

git-svn-id: branches/jvmbackend@20901 -

Jonas Maebe 13 年之前
父節點
當前提交
02413c8a57
共有 8 個文件被更改,包括 278 次插入130 次删除
  1. 2 2
      compiler/assemble.pas
  2. 257 0
      compiler/cfileutl.pas
  3. 1 1
      compiler/comprsrc.pas
  4. 4 101
      compiler/cutils.pas
  5. 5 23
      compiler/globals.pas
  6. 3 0
      compiler/globtype.pas
  7. 5 2
      compiler/impdef.pas
  8. 1 1
      compiler/link.pas

+ 2 - 2
compiler/assemble.pas

@@ -378,8 +378,8 @@ Implementation
           end;
         try
           FlushOutput;
-          DosExitCode := ExecuteProcess(command,para);
-          if DosExitCode <>0
+          DosExitCode:=RequotedExecuteProcess(command,para);
+          if DosExitCode<>0
           then begin
             Message1(exec_e_error_while_assembling,tostr(dosexitcode));
             result:=false;

+ 257 - 0
compiler/cfileutl.pas

@@ -122,10 +122,19 @@ interface
     function  FindFileInExeLocations(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
     function  FindExe(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
     function  GetShortName(const n:TCmdStr):TCmdStr;
+    function maybequoted(const s:string):string;
+    function maybequoted(const s:ansistring):ansistring;
 
     procedure InitFileUtils;
     procedure DoneFileUtils;
 
+    function RequotedExecuteProcess(const Path: AnsiString; const ComLine: AnsiString; Flags: TExecuteFlags = []): Longint;
+    function RequotedExecuteProcess(const Path: AnsiString; const ComLine: array of AnsiString; Flags: TExecuteFlags = []): Longint;
+    function Shell(const command:ansistring): longint;
+
+  { hide Sysutils.ExecuteProcess in units using this one after SysUtils}
+  const
+    ExecuteProcess = 'Do not use' deprecated 'Use cfileutil.RequotedExecuteProcess instead, ExecuteProcess cannot deal with single quotes as used by Unix command lines';
 
 { * Since native Amiga commands can't handle Unix-style relative paths used by the compiler,
     and some GNU tools, Unix2AmigaPath is needed to handle such situations (KB) * }
@@ -1290,6 +1299,254 @@ end;
       end;
 
 
+    function maybequoted(const s:string):string;
+    const
+      FORBIDDEN_CHARS_DOS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
+                         '{', '}', '''', '`', '~'];
+      FORBIDDEN_CHARS_OTHER = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
+                         '{', '}', '''', ':', '\', '`', '~'];
+    var
+      forbidden_chars: set of char;
+      i  : integer;
+      quote_script: tscripttype;
+      quote_char: ansichar;
+      quoted : boolean;
+    begin
+      if not(cs_link_on_target in current_settings.globalswitches) then
+        quote_script:=source_info.script
+      else
+        quote_script:=target_info.script;
+      if quote_script=script_dos then
+        forbidden_chars:=FORBIDDEN_CHARS_DOS
+      else
+        begin
+          forbidden_chars:=FORBIDDEN_CHARS_OTHER;
+          if quote_script=script_unix then
+            include(forbidden_chars,'"');
+        end;
+      if quote_script=script_unix then
+        quote_char:=''''
+      else
+        quote_char:='"';
+
+      quoted:=false;
+      result:=quote_char;
+      for i:=1 to length(s) do
+       begin
+         if s[i]=quote_char then
+           begin
+             quoted:=true;
+             result:=result+'\'+quote_char;
+           end
+         else case s[i] of
+           '\':
+             begin
+               if quote_script=script_unix then
+                 begin
+                   result:=result+'\\';
+                   quoted:=true
+                 end
+               else
+                 result:=result+'\';
+             end;
+           ' ',
+           #128..#255 :
+             begin
+               quoted:=true;
+               result:=result+s[i];
+             end;
+           else begin
+             if s[i] in forbidden_chars then
+               quoted:=True;
+             result:=result+s[i];
+           end;
+         end;
+       end;
+      if quoted then
+        result:=result+quote_char
+      else
+        result:=s;
+    end;
+
+
+    function maybequoted_for_script(const s:ansistring; quote_script: tscripttype):ansistring;
+      const
+        FORBIDDEN_CHARS_DOS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
+                           '{', '}', '''', '`', '~'];
+        FORBIDDEN_CHARS_OTHER = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
+                           '{', '}', '''', ':', '\', '`', '~'];
+      var
+        forbidden_chars: set of char;
+        i  : integer;
+        quote_char: ansichar;
+        quoted : boolean;
+      begin
+        if quote_script=script_dos then
+          forbidden_chars:=FORBIDDEN_CHARS_DOS
+        else
+          begin
+            forbidden_chars:=FORBIDDEN_CHARS_OTHER;
+            if quote_script=script_unix then
+              include(forbidden_chars,'"');
+          end;
+        if quote_script=script_unix then
+          quote_char:=''''
+        else
+          quote_char:='"';
+
+        quoted:=false;
+        result:=quote_char;
+        for i:=1 to length(s) do
+         begin
+           if s[i]=quote_char then
+             begin
+               quoted:=true;
+               result:=result+'\'+quote_char;
+             end
+           else case s[i] of
+             '\':
+               begin
+                 if quote_script=script_unix then
+                   begin
+                     result:=result+'\\';
+                     quoted:=true
+                   end
+                 else
+                   result:=result+'\';
+               end;
+             ' ',
+             #128..#255 :
+               begin
+                 quoted:=true;
+                 result:=result+s[i];
+               end;
+             else begin
+               if s[i] in forbidden_chars then
+                 quoted:=True;
+               result:=result+s[i];
+             end;
+           end;
+         end;
+        if quoted then
+          result:=result+quote_char
+        else
+          result:=s;
+      end;
+
+
+    function maybequoted(const s:ansistring):ansistring;
+      var
+        quote_script: tscripttype;
+      begin
+        if not(cs_link_on_target in current_settings.globalswitches) then
+          quote_script:=source_info.script
+        else
+          quote_script:=target_info.script;
+        result:=maybequoted_for_script(s,quote_script);
+      end;
+
+
+    { requotes a string that was quoted for Unix for passing to ExecuteProcess,
+      because it only supports Windows-style quoting; this routine assumes that
+      everything that has to be quoted for Windows, was also quoted (but
+      differently for Unix) -- which is the case }
+    function UnixRequoteForExecuteProcess(const QuotedStr: TCmdStr): TCmdStr;
+      var
+        i: longint;
+        temp: TCmdStr;
+        inquotes: boolean;
+      begin
+        if QuotedStr='' then
+          begin
+            result:='';
+            exit;
+          end;
+        inquotes:=false;
+        result:='';
+        i:=1;
+        while i<=length(QuotedStr) do
+          begin
+            case QuotedStr[i] of
+              '''':
+                begin
+                  if not(inquotes) then
+                    begin
+                      inquotes:=true;
+                      temp:=''
+                    end
+                  else
+                    begin
+                      { requote for Windows }
+                      result:=result+maybequoted_for_script(temp,script_dos);
+                      inquotes:=false;
+                    end;
+                end;
+              '\':
+                begin
+                  if inquotes then
+                    temp:=temp+QuotedStr[i+1]
+                  else
+                    result:=result+QuotedStr[i+1];
+                  inc(i);
+                end;
+              else
+                begin
+                  if inquotes then
+                    temp:=temp+QuotedStr[i]
+                  else
+                    result:=result+QuotedStr[i];
+                end;
+            end;
+            inc(i);
+          end;
+      end;
+
+
+    function RequotedExecuteProcess(const Path: AnsiString; const ComLine: AnsiString; Flags: TExecuteFlags): Longint;
+      var
+        quote_script: tscripttype;
+      begin
+        if not(cs_link_on_target in current_settings.globalswitches) then
+          quote_script:=target_info.script
+        else
+          quote_script:=source_info.script;
+        if quote_script=script_unix then
+          result:=sysutils.ExecuteProcess(Path,UnixRequoteForExecuteProcess(ComLine),Flags)
+        else
+          result:=sysutils.ExecuteProcess(Path,ComLine,Flags)
+      end;
+
+
+    function RequotedExecuteProcess(const Path: AnsiString; const ComLine: array of AnsiString; Flags: TExecuteFlags): Longint;
+      begin
+        result:=sysutils.ExecuteProcess(Path,ComLine,Flags);
+      end;
+
+
+    function Shell(const command:ansistring): longint;
+      { This is already defined in the linux.ppu for linux, need for the *
+        expansion under linux }
+{$ifdef hasunix}
+      begin
+        result := Unix.fpsystem(command);
+      end;
+{$else hasunix}
+  {$ifdef amigashell}
+      begin
+        result := RequotedExecuteProcess('',command);
+      end;
+  {$else amigashell}
+      var
+        comspec : string;
+      begin
+        comspec:=GetEnvironmentVariable('COMSPEC');
+        result := RequotedExecuteProcess(comspec,' /C '+command);
+      end;
+   {$endif amigashell}
+{$endif hasunix}
+
+
+
 {****************************************************************************
                            Init / Done
 ****************************************************************************}

+ 1 - 1
compiler/comprsrc.pas

@@ -198,7 +198,7 @@ begin
      Message2(exec_d_resbin_params,resbin,s);
      FlushOutput;
      try
-       if ExecuteProcess(resbin,s) <> 0 then
+       if RequotedExecuteProcess(resbin,s) <> 0 then
        begin
          if not (cs_link_nolink in current_settings.globalswitches) then
            Message(exec_e_error_while_compiling_resources);

+ 4 - 101
compiler/cutils.pas

@@ -92,8 +92,6 @@ interface
     function nextpowerof2(value : int64; out power: longint) : int64;
     function backspace_quote(const s:string;const qchars:Tcharset):string;
     function octal_quote(const s:string;const qchars:Tcharset):string;
-    function maybequoted(const s:string):string;
-    function maybequoted(const s:ansistring):ansistring;
 
     {# If the string is quoted, in accordance with pascal, it is
        dequoted and returned in s, and the function returns true.
@@ -147,6 +145,10 @@ interface
 
     Function nextafter(x,y:double):double;
 
+  { hide Sysutils.ExecuteProcess in units using this one after SysUtils}
+  const
+    ExecuteProcess = 'Do not use' deprecated 'Use cfileutil.RequotedExecuteProcess instead, ExecuteProcess cannot deal with single quotes as used by Unix command lines';
+
 implementation
 
     uses
@@ -902,105 +904,6 @@ implementation
         end;
     end;
 
-    function maybequoted(const s:ansistring):ansistring;
-      const
-        {$IFDEF MSWINDOWS}
-          FORBIDDEN_CHARS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
-                             '{', '}', '''', '`', '~'];
-          QUOTE_CHAR = '"';
-        {$ELSE}
-          FORBIDDEN_CHARS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
-                             '{', '}', '''', ':', '\', '`', '~'];
-          {$ifdef unix}
-          QUOTE_CHAR = '''';
-          {$else}
-          QUOTE_CHAR = '"';
-          {$endif}
-        {$ENDIF}
-      var
-        s1 : ansistring;
-        i  : integer;
-        quoted : boolean;
-      begin
-        quoted:=false;
-        s1:=QUOTE_CHAR;
-        for i:=1 to length(s) do
-         begin
-           case s[i] of
-             QUOTE_CHAR :
-               begin
-                 quoted:=true;
-                 s1:=s1+('\'+QUOTE_CHAR);
-               end;
-             ' ',
-             #128..#255 :
-               begin
-                 quoted:=true;
-                 s1:=s1+s[i];
-               end;
-             else begin
-               if s[i] in FORBIDDEN_CHARS then
-                 quoted:=True;
-               s1:=s1+s[i];
-             end;
-           end;
-         end;
-        if quoted then
-          maybequoted:=s1+QUOTE_CHAR
-        else
-          maybequoted:=s;
-      end;
-
-
-    function maybequoted(const s:string):string;
-      const
-        {$IFDEF MSWINDOWS}
-          FORBIDDEN_CHARS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
-                             '{', '}', '''', '`', '~'];
-          QUOTE_CHAR = '"';
-        {$ELSE}
-          FORBIDDEN_CHARS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
-                             '{', '}', '"', ':', '\', '`', '~'];
-          {$ifdef unix}
-          QUOTE_CHAR = '''';
-          {$else}
-          QUOTE_CHAR = '"';
-          {$endif}
-        {$ENDIF}
-      var
-        s1 : string;
-        i  : integer;
-        quoted : boolean;
-      begin
-        quoted:=false;
-        s1:=QUOTE_CHAR;
-        for i:=1 to length(s) do
-         begin
-           case s[i] of
-             QUOTE_CHAR :
-               begin
-                 quoted:=true;
-                 s1:=s1+('\'+QUOTE_CHAR);
-               end;
-             ' ',
-             #128..#255 :
-               begin
-                 quoted:=true;
-                 s1:=s1+s[i];
-               end;
-             else begin
-               if s[i] in FORBIDDEN_CHARS then
-                 quoted:=True;
-               s1:=s1+s[i];
-             end;
-           end;
-         end;
-        if quoted then
-          maybequoted:=s1+QUOTE_CHAR
-        else
-          maybequoted:=s;
-      end;
-
 
     function DePascalQuote(var s: ansistring): Boolean;
       var

+ 5 - 23
compiler/globals.pas

@@ -467,7 +467,6 @@ interface
 
     procedure DefaultReplacements(var s:ansistring);
 
-    function Shell(const command:ansistring): longint;
     function  GetEnvPChar(const envname:string):pchar;
     procedure FreeEnvPChar(p:pchar);
 
@@ -509,6 +508,11 @@ interface
 {$endif ARM}
     function floating_point_range_check_error : boolean;
 
+  { hide Sysutils.ExecuteProcess in units using this one after SysUtils}
+  const
+    ExecuteProcess = 'Do not use' deprecated 'Use cfileutil.RequotedExecuteProcess instead, ExecuteProcess cannot deal with single quotes as used by Unix command lines';
+
+
 implementation
 
     uses
@@ -889,28 +893,6 @@ implementation
   {$define AMIGASHELL}
 {$endif}
 
-    function Shell(const command:ansistring): longint;
-      { This is already defined in the linux.ppu for linux, need for the *
-        expansion under linux }
-{$ifdef hasunix}
-      begin
-        result := Unix.fpsystem(command);
-      end;
-{$else hasunix}
-  {$ifdef amigashell}
-      begin
-        result := ExecuteProcess('',command);
-      end;
-  {$else amigashell}
-      var
-        comspec : string;
-      begin
-        comspec:=GetEnvironmentVariable('COMSPEC');
-        result := ExecuteProcess(comspec,' /C '+command);
-      end;
-   {$endif amigashell}
-{$endif hasunix}
-
 {$UNDEF AMIGASHELL}
       function is_number_float(d : double) : boolean;
         var

+ 3 - 0
compiler/globtype.pas

@@ -607,6 +607,9 @@ interface
       end;
 
 
+  { hide Sysutils.ExecuteProcess in units using this one after SysUtils}
+  const
+    ExecuteProcess = 'Do not use' deprecated 'Use cfileutil.RequotedExecuteProcess instead, ExecuteProcess cannot deal with single quotes as used by Unix command lines';
 
 implementation
 

+ 5 - 2
compiler/impdef.pas

@@ -46,6 +46,9 @@ interface
 
 implementation
 
+uses
+  cfileutl;
+
 {$IFDEF STANDALONE}
 var
   __textname : string;
@@ -170,7 +173,7 @@ procedure CreateTempDir(const s:string);
 procedure call_as(const name:string);
  begin
   FlushOutput;
-  ExecuteProcess(as_name,'-o '+name+'o '+name);
+  RequotedExecuteProcess(as_name,'-o '+name+'o '+name);
  end;
 procedure call_ar;
  var
@@ -186,7 +189,7 @@ procedure call_ar;
   If DOSError=0 then
    erase(f);
   FlushOutput;
-  ExecuteProcess(ar_name,'rs '+impname+' '+path+dirsep+'*.swo');
+  RequotedExecuteProcess(ar_name,'rs '+impname+' '+path+dirsep+'*.swo');
   cleardir(path,'*.sw');
   cleardir(path,'*.swo');
   {$push} {$I-}

+ 1 - 1
compiler/link.pas

@@ -718,7 +718,7 @@ Implementation
              exitcode:=shell(maybequoted(command)+' '+para)
            else
              try
-               exitcode:=ExecuteProcess(command,para);
+               exitcode:=RequotedExecuteProcess(command,para);
              except on E:EOSError do
                begin
                  Message(exec_e_cant_call_linker);