paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-14 08:46:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

* moved maybequoted() from cutils to cfileutl and let its behaviour vary

Browse Source 
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 -
This commit is contained in:
Jonas Maebe 2012-04-16 19:52:36 +00:00
parent ac419e1cb4
commit 02413c8a57
8 changed files with 278 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/assemble.pas
View File

@ -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
compiler/cfileutl.pas
View File

@ -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
****************************************************************************}

2
compiler/comprsrc.pas
View File

@ -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);

105
compiler/cutils.pas
View File

@ -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

28
compiler/globals.pas
View File

@ -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
compiler/globtype.pas
View File

@ -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

7
compiler/impdef.pas
View File

@ -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-}

2
compiler/link.pas
View File

@ -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);