diff --git a/compiler/assemble.pas b/compiler/assemble.pas index 0eee869272..560cc71186 100644 --- a/compiler/assemble.pas +++ b/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; diff --git a/compiler/cfileutl.pas b/compiler/cfileutl.pas index e3fb112e35..ad275e2044 100644 --- a/compiler/cfileutl.pas +++ b/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 ****************************************************************************} diff --git a/compiler/comprsrc.pas b/compiler/comprsrc.pas index 8a983cc061..57d92df00f 100644 --- a/compiler/comprsrc.pas +++ b/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); diff --git a/compiler/cutils.pas b/compiler/cutils.pas index 5ad97aad6c..dc41ac209a 100644 --- a/compiler/cutils.pas +++ b/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 diff --git a/compiler/globals.pas b/compiler/globals.pas index a8778adf6d..009a43a78e 100644 --- a/compiler/globals.pas +++ b/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 diff --git a/compiler/globtype.pas b/compiler/globtype.pas index 9f84fa45f2..db2ebd2333 100644 --- a/compiler/globtype.pas +++ b/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 diff --git a/compiler/impdef.pas b/compiler/impdef.pas index 7cb0b8fee0..dbbe56327f 100644 --- a/compiler/impdef.pas +++ b/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-} diff --git a/compiler/link.pas b/compiler/link.pas index 2020947365..d786e69824 100644 --- a/compiler/link.pas +++ b/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);