|
|
@@ -0,0 +1,1250 @@
|
|
|
+{
|
|
|
+ $Id: unix.pp,v 1.85 2005/03/25 22:53:39 jonas Exp $
|
|
|
+ This file is part of the Free Pascal run time library.
|
|
|
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
|
|
|
+ BSD parts (c) 2000 by Marco van de Voort
|
|
|
+ members of the Free Pascal development team.
|
|
|
+
|
|
|
+ See the file COPYING.FPC, included in this distribution,
|
|
|
+ for details about the copyright.
|
|
|
+
|
|
|
+ This program is distributed in the hope that it will be useful,
|
|
|
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
|
|
|
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
+
|
|
|
+**********************************************************************}
|
|
|
+Unit Unix;
|
|
|
+Interface
|
|
|
+
|
|
|
+Uses BaseUnix,UnixType;
|
|
|
+
|
|
|
+{$i aliasptp.inc}
|
|
|
+
|
|
|
+{ Get Types and Constants only exported in this unit }
|
|
|
+{$i unxconst.inc}
|
|
|
+
|
|
|
+// We init to zero to be able to put timezone stuff under IFDEF, and still
|
|
|
+// keep the code working.
|
|
|
+
|
|
|
+var
|
|
|
+ Tzseconds : Longint {$ifndef ver1_0} = 0 {$endif};
|
|
|
+
|
|
|
+
|
|
|
+{********************
|
|
|
+ File
|
|
|
+********************}
|
|
|
+
|
|
|
+Const
|
|
|
+ P_IN = 1; // pipes (?)
|
|
|
+ P_OUT = 2;
|
|
|
+
|
|
|
+Const
|
|
|
+ LOCK_SH = 1; // flock constants ?
|
|
|
+ LOCK_EX = 2;
|
|
|
+ LOCK_UN = 8;
|
|
|
+ LOCK_NB = 4;
|
|
|
+
|
|
|
+Type
|
|
|
+ Tpipe = baseunix.tfildes; // compability.
|
|
|
+
|
|
|
+{******************************************************************************
|
|
|
+ Procedure/Functions
|
|
|
+******************************************************************************}
|
|
|
+
|
|
|
+{**************************
|
|
|
+ Time/Date Handling
|
|
|
+***************************}
|
|
|
+
|
|
|
+var
|
|
|
+ tzdaylight : boolean;
|
|
|
+ tzname : array[boolean] of pchar;
|
|
|
+
|
|
|
+{$IFNDEF DONT_READ_TIMEZONE} // allows to disable linking in and trying for platforms
|
|
|
+ // it doesn't (yet) work for.
|
|
|
+
|
|
|
+{ timezone support }
|
|
|
+procedure GetLocalTimezone(timer:cint;var leap_correct,leap_hit:cint);
|
|
|
+procedure GetLocalTimezone(timer:cint);
|
|
|
+procedure ReadTimezoneFile(fn:string);
|
|
|
+function GetTimezoneFile:string;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+{**************************
|
|
|
+ Process Handling
|
|
|
+***************************}
|
|
|
+
|
|
|
+//
|
|
|
+// These are much better, in nearly all ways.
|
|
|
+//
|
|
|
+
|
|
|
+function FpExecLE (Const PathName:AnsiString;const S:Array Of AnsiString;MyEnv:ppchar):cint;
|
|
|
+function FpExecL(Const PathName:AnsiString;const S:Array Of AnsiString):cint;
|
|
|
+function FpExecLP(Const PathName:AnsiString;const S:Array Of AnsiString):cint;
|
|
|
+function FpExecV(Const PathName:AnsiString;args:ppchar):cint;
|
|
|
+function FpExecVP(Const PathName:AnsiString;args:ppchar):cint;
|
|
|
+function FpExecVPE(Const PathName:AnsiString;args,env:ppchar):cint;
|
|
|
+
|
|
|
+Function Shell (const Command:String):cint;
|
|
|
+Function Shell (const Command:AnsiString):cint;
|
|
|
+Function fpSystem(const Command:AnsiString):cint;
|
|
|
+
|
|
|
+Function WaitProcess (Pid:cint):cint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
|
|
|
+
|
|
|
+Function WIFSTOPPED (Status: Integer): Boolean;
|
|
|
+Function W_EXITCODE (ReturnCode, Signal: Integer): Integer;
|
|
|
+Function W_STOPCODE (Signal: Integer): Integer;
|
|
|
+
|
|
|
+{**************************
|
|
|
+ File Handling
|
|
|
+***************************}
|
|
|
+
|
|
|
+{$ifndef FPC_USE_LIBC} // defined using cdecl for libc.
|
|
|
+Function fsync (fd : cint) : cint;
|
|
|
+Function fpFlock (fd,mode : cint) : cint ;
|
|
|
+Function fStatFS (Fd: cint;Var Info:tstatfs):cint;
|
|
|
+Function StatFS (Path:pchar;Var Info:tstatfs):cint;
|
|
|
+{$endif}
|
|
|
+
|
|
|
+Function fpFlock (var T : text;mode : cint) : cint;
|
|
|
+Function fpFlock (var F : File;mode : cint) : cint;
|
|
|
+
|
|
|
+
|
|
|
+Function SelectText (var T:Text;TimeOut :PTimeVal):cint;
|
|
|
+Function SelectText (var T:Text;TimeOut :cint):cint;
|
|
|
+
|
|
|
+{**************************
|
|
|
+ Directory Handling
|
|
|
+***************************}
|
|
|
+
|
|
|
+procedure SeekDir(p:pdir;loc:clong);
|
|
|
+function TellDir(p:pdir):clong;
|
|
|
+
|
|
|
+{**************************
|
|
|
+ Pipe/Fifo/Stream
|
|
|
+***************************}
|
|
|
+
|
|
|
+Function AssignPipe (var pipe_in,pipe_out:cint):cint;
|
|
|
+Function AssignPipe (var pipe_in,pipe_out:text):cint;
|
|
|
+Function AssignPipe (var pipe_in,pipe_out:file):cint;
|
|
|
+//Function PClose (Var F:text) : cint;
|
|
|
+//Function PClose (Var F:file) : cint;
|
|
|
+Function POpen (var F:text;const Prog:String;rw:char):cint;
|
|
|
+Function POpen (var F:file;const Prog:String;rw:char):cint;
|
|
|
+Function AssignStream(Var StreamIn,Streamout:text;Const Prog:ansiString;const args : array of ansistring) : cint;
|
|
|
+Function AssignStream(Var StreamIn,Streamout,streamerr:text;Const Prog:ansiString;const args : array of ansistring) : cint;
|
|
|
+
|
|
|
+{$ifdef linux}
|
|
|
+Function GetDomainName:String;
|
|
|
+{$endif}
|
|
|
+Function GetHostName:String;
|
|
|
+
|
|
|
+
|
|
|
+{**************************
|
|
|
+ Memory functions
|
|
|
+***************************}
|
|
|
+
|
|
|
+const
|
|
|
+ PROT_READ = $1; { page can be read }
|
|
|
+ PROT_WRITE = $2; { page can be written }
|
|
|
+ PROT_EXEC = $4; { page can be executed }
|
|
|
+ PROT_NONE = $0; { page can not be accessed }
|
|
|
+
|
|
|
+ MAP_SHARED = $1; { Share changes }
|
|
|
+// MAP_PRIVATE = $2; { Changes are private }
|
|
|
+ MAP_TYPE = $f; { Mask for type of mapping }
|
|
|
+ MAP_FIXED = $10; { Interpret addr exactly }
|
|
|
+// MAP_ANONYMOUS = $20; { don't use a file }
|
|
|
+
|
|
|
+{$ifdef Linux}
|
|
|
+ MAP_GROWSDOWN = $100; { stack-like segment }
|
|
|
+ MAP_DENYWRITE = $800; { ETXTBSY }
|
|
|
+ MAP_EXECUTABLE = $1000; { mark it as an executable }
|
|
|
+ MAP_LOCKED = $2000; { pages are locked }
|
|
|
+ MAP_NORESERVE = $4000; { don't check for reservations }
|
|
|
+{$else}
|
|
|
+ {$ifdef FreeBSD}
|
|
|
+ // FreeBSD defines MAP_COPY=MAP_PRIVATE=$2;
|
|
|
+ MAP_FILE = $0000; { map from file (default) }
|
|
|
+ MAP_ANON = $1000; { allocated from memory, swap space }
|
|
|
+
|
|
|
+ MAP_RENAME = $0020; { Sun: rename private pages to file }
|
|
|
+ MAP_NORESERVE = $0040; { Sun: don't reserve needed swap area }
|
|
|
+ MAP_INHERIT = $0080; { region is retained after exec }
|
|
|
+ MAP_NOEXTEND = $0100; { for MAP_FILE, don't change file size }
|
|
|
+ MAP_HASSEMAPHORE = $0200; { region may contain semaphores }
|
|
|
+ MAP_STACK = $0400; { region grows down, like a stack }
|
|
|
+ MAP_NOSYNC = $0800; { page to but do not sync underlying file}
|
|
|
+ MAP_NOCORE = $20000;{ dont include these pages in a coredump}
|
|
|
+ {$endif}
|
|
|
+{$endif}
|
|
|
+{**************************
|
|
|
+ Utility functions
|
|
|
+***************************}
|
|
|
+
|
|
|
+Type
|
|
|
+ TFSearchOption = (NoCurrentDirectory,
|
|
|
+ CurrentDirectoryFirst,
|
|
|
+ CurrentDirectoryLast);
|
|
|
+
|
|
|
+Function FSearch (const path:AnsiString;dirlist:Ansistring;CurrentDirStrategy:TFSearchOption):AnsiString;
|
|
|
+Function FSearch (const path:AnsiString;dirlist:AnsiString):AnsiString;
|
|
|
+
|
|
|
+procedure SigRaise (sig:integer);
|
|
|
+
|
|
|
+{$ifdef FPC_USE_LIBC}
|
|
|
+ const clib = 'c';
|
|
|
+ {$i unxdeclh.inc}
|
|
|
+{$else}
|
|
|
+ {$i unxsysch.inc} // calls used in system and not reexported from baseunix
|
|
|
+{$endif}
|
|
|
+
|
|
|
+{******************************************************************************
|
|
|
+ Implementation
|
|
|
+******************************************************************************}
|
|
|
+
|
|
|
+{$i unxovlh.inc}
|
|
|
+
|
|
|
+Implementation
|
|
|
+
|
|
|
+Uses Strings{$ifndef FPC_USE_LIBC},Syscall{$endif};
|
|
|
+
|
|
|
+{$i unxovl.inc}
|
|
|
+
|
|
|
+{$ifndef FPC_USE_LIBC}
|
|
|
+ {$i syscallh.inc}
|
|
|
+ {$i unxsysc.inc}
|
|
|
+{$endif}
|
|
|
+
|
|
|
+{ Get the definitions of textrec and filerec }
|
|
|
+{$i textrec.inc}
|
|
|
+{$i filerec.inc}
|
|
|
+
|
|
|
+{$i unxfunc.inc} { Platform specific implementations }
|
|
|
+
|
|
|
+Function getenv(name:string):Pchar; external name 'FPC_SYSC_FPGETENV';
|
|
|
+
|
|
|
+{******************************************************************************
|
|
|
+ Process related calls
|
|
|
+******************************************************************************}
|
|
|
+
|
|
|
+{ Most calls of WaitPID do not handle the result correctly, this funktion treats errors more correctly }
|
|
|
+Function WaitProcess(Pid:cint):cint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
|
|
|
+var
|
|
|
+ r,s : cint;
|
|
|
+begin
|
|
|
+ s:=$7F00;
|
|
|
+
|
|
|
+ repeat
|
|
|
+ r:=fpWaitPid(Pid,@s,0);
|
|
|
+ if (r=-1) and (fpgeterrno=ESysEIntr) Then
|
|
|
+ r:=0;
|
|
|
+ until (r<>0);
|
|
|
+ if (r=-1) or (r=0) then // 0 is not a valid return and should never occur (it means status invalid when using WNOHANG)
|
|
|
+ WaitProcess:=-1 // return -1 to indicate an error. fpwaitpid updated it.
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ if wifexited(s) then
|
|
|
+ WaitProcess:=wexitstatus(s)
|
|
|
+ else if (s>0) then // Until now there is not use of the highest bit , but check this for the future
|
|
|
+ WaitProcess:=-s // normal case
|
|
|
+ else
|
|
|
+ WaitProcess:=s; // s<0 should not occur, but wie return also a negativ value
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function intFpExecVEMaybeP (Const PathName:AnsiString;Args,MyEnv:ppchar;SearchPath:Boolean):cint;
|
|
|
+// does an ExecVE, but still has to handle P
|
|
|
+// execv variants call this directly, execl variants indirectly via
|
|
|
+// intfpexecl
|
|
|
+
|
|
|
+Var
|
|
|
+ NewCmd : ansistring;
|
|
|
+ ThePath : AnsiString;
|
|
|
+
|
|
|
+Begin
|
|
|
+ If SearchPath and (pos('/',pathname)=0) Then
|
|
|
+ Begin
|
|
|
+ // The above could be better. (check if not escaped/quoted '/'s) ?
|
|
|
+ // (Jilles says this is ok)
|
|
|
+ // Stevens says only search if newcmd contains no '/'
|
|
|
+ // fsearch is not ansistring clean yet.
|
|
|
+ ThePath:=fpgetenv('PATH');
|
|
|
+ if thepath='' then
|
|
|
+ thepath:='.'; // FreeBSD uses _PATH_DEFPATH = /usr/bin:/bin
|
|
|
+ // but a quick check showed that _PATH_DEFPATH
|
|
|
+ // varied from OS to OS
|
|
|
+
|
|
|
+ newcmd:=FSearch(pathname,thepath,NoCurrentDirectory);
|
|
|
+ // FreeBSD libc keeps on trying till a file is successfully run.
|
|
|
+ // Stevens says "try each path prefix"
|
|
|
+
|
|
|
+ // execp puts newcmd here.
|
|
|
+ args^:=pchar(newcmd);
|
|
|
+ End else
|
|
|
+ newcmd:=pathname;
|
|
|
+ // repeat
|
|
|
+// if searchpath then args^:=pchar(commandtorun)
|
|
|
+
|
|
|
+ IntFpExecVEMaybeP:=fpExecVE(newcmd,Args,MyEnv);
|
|
|
+{
|
|
|
+// Code that if exec fails due to permissions, tries to run it with sh
|
|
|
+// Should we deallocate p on fail? -> no fpexit is run no matter what
|
|
|
+//
|
|
|
+}
|
|
|
+// if intfpexecvemaybep=-1 then zoekvolgende file.
|
|
|
+// until (Goexit) or SearchExit;
|
|
|
+
|
|
|
+
|
|
|
+{
|
|
|
+ If IntFpExec=-1 Then
|
|
|
+ Begin
|
|
|
+ Error:=fpGetErrno
|
|
|
+ Case Error of
|
|
|
+ ESysE2Big : Exit(-1);
|
|
|
+ ESysELoop,
|
|
|
+ : Exit(-1);
|
|
|
+
|
|
|
+}
|
|
|
+end;
|
|
|
+
|
|
|
+function intFpExecl (Const PathName:AnsiString;const s:array of ansistring;MyEnv:ppchar;SearchPath:Boolean):cint;
|
|
|
+{ Handles the array of ansistring -> ppchar conversion.
|
|
|
+ Base for the the "l" variants.
|
|
|
+}
|
|
|
+var p:ppchar;
|
|
|
+
|
|
|
+begin
|
|
|
+ If PathName='' Then
|
|
|
+ Begin
|
|
|
+ fpsetErrno(ESysEnoEnt);
|
|
|
+ Exit(-1); // Errno?
|
|
|
+ End;
|
|
|
+ p:=ArrayStringToPPchar(s,1);
|
|
|
+ if p=NIL Then
|
|
|
+ Begin
|
|
|
+ GetMem(p,2*sizeof(pchar));
|
|
|
+ if p=nil then
|
|
|
+ begin
|
|
|
+ {$ifdef xunix}
|
|
|
+ fpseterrno(ESysEnoMem);
|
|
|
+ {$endif}
|
|
|
+ fpseterrno(ESysEnoEnt);
|
|
|
+ exit(-1);
|
|
|
+ end;
|
|
|
+ p[1]:=nil;
|
|
|
+ End;
|
|
|
+ p^:=pchar(PathName);
|
|
|
+ IntFPExecL:=intFpExecVEMaybeP(PathName,p,MyEnv,SearchPath);
|
|
|
+ // If we come here, no attempts were executed successfully.
|
|
|
+ Freemem(p);
|
|
|
+end;
|
|
|
+
|
|
|
+function FpExecLE (Const PathName:AnsiString;const S:Array Of AnsiString;MyEnv:ppchar):cint;
|
|
|
+
|
|
|
+Begin
|
|
|
+ FpExecLE:=intFPExecl(PathName,s,MyEnv,false);
|
|
|
+End;
|
|
|
+
|
|
|
+function FpExecL(Const PathName:AnsiString;const S:Array Of AnsiString):cint;
|
|
|
+
|
|
|
+Begin
|
|
|
+ FpExecL:=intFPExecl(PathName,S,EnvP,false);
|
|
|
+End;
|
|
|
+
|
|
|
+function FpExecLP(Const PathName:AnsiString;const S:Array Of AnsiString):cint;
|
|
|
+
|
|
|
+Begin
|
|
|
+ FpExecLP:=intFPExecl(PathName,S,EnvP,True);
|
|
|
+End;
|
|
|
+
|
|
|
+function FpExecV(Const PathName:AnsiString;args:ppchar):cint;
|
|
|
+
|
|
|
+Begin
|
|
|
+ fpexecV:=intFpExecVEMaybeP (PathName,args,envp,false);
|
|
|
+End;
|
|
|
+
|
|
|
+function FpExecVP(Const PathName:AnsiString;args:ppchar):cint;
|
|
|
+
|
|
|
+Begin
|
|
|
+ fpexecVP:=intFpExecVEMaybeP (PathName,args,envp,true);
|
|
|
+End;
|
|
|
+
|
|
|
+function FpExecVPE(Const PathName:AnsiString;args,env:ppchar):cint;
|
|
|
+
|
|
|
+Begin
|
|
|
+ fpexecVPE:=intFpExecVEMaybeP (PathName,args,env,true);
|
|
|
+End;
|
|
|
+
|
|
|
+// exect and execvP (ExecCapitalP) are not implement
|
|
|
+// Non POSIX anyway.
|
|
|
+// Exect turns on tracing for the process
|
|
|
+// execvP has the searchpath as array of ansistring ( const char *search_path)
|
|
|
+
|
|
|
+{$define FPC_USE_FPEXEC}
|
|
|
+Function Shell(const Command:String):cint;
|
|
|
+{
|
|
|
+ Executes the shell, and passes it the string Command. (Through /bin/sh -c)
|
|
|
+ The current environment is passed to the shell.
|
|
|
+ It waits for the shell to exit, and returns its exit status.
|
|
|
+ If the Exec call failed exit status 127 is reported.
|
|
|
+}
|
|
|
+{ Changed the structure:
|
|
|
+- the previous version returns an undefinied value if fork fails
|
|
|
+- it returns the status of Waitpid instead of the Process returnvalue (see the doc to Shell)
|
|
|
+- it uses exit(127) not ExitProc (The Result in pp386: going on Compiling in 2 processes!)
|
|
|
+- ShellArgs are now released
|
|
|
+- The Old CreateShellArg gives back pointers to a local var
|
|
|
+}
|
|
|
+var
|
|
|
+{$ifndef FPC_USE_FPEXEC}
|
|
|
+ p : ppchar;
|
|
|
+{$endif}
|
|
|
+ pid : cint;
|
|
|
+begin
|
|
|
+ {$ifndef FPC_USE_FPEXEC}
|
|
|
+ p:=CreateShellArgv(command);
|
|
|
+{$endif}
|
|
|
+ pid:=fpfork;
|
|
|
+ if pid=0 then // We are in the Child
|
|
|
+ begin
|
|
|
+ {This is the child.}
|
|
|
+ {$ifndef FPC_USE_FPEXEC}
|
|
|
+ fpExecve(p^,p,envp);
|
|
|
+ {$else}
|
|
|
+ fpexecl('/bin/sh',['-c',Command]);
|
|
|
+ {$endif}
|
|
|
+ fpExit(127); // was Exit(127)
|
|
|
+ end
|
|
|
+ else if (pid<>-1) then // Successfull started
|
|
|
+ Shell:=WaitProcess(pid)
|
|
|
+ else // no success
|
|
|
+ Shell:=-1; // indicate an error
|
|
|
+ {$ifndef FPC_USE_FPEXEC}
|
|
|
+ FreeShellArgV(p);
|
|
|
+ {$endif}
|
|
|
+end;
|
|
|
+
|
|
|
+Function Shell(const Command:AnsiString):cint;
|
|
|
+{
|
|
|
+ AnsiString version of Shell
|
|
|
+}
|
|
|
+var
|
|
|
+{$ifndef FPC_USE_FPEXEC}
|
|
|
+ p : ppchar;
|
|
|
+{$endif}
|
|
|
+ pid : cint;
|
|
|
+begin { Changes as above }
|
|
|
+{$ifndef FPC_USE_FPEXEC}
|
|
|
+ p:=CreateShellArgv(command);
|
|
|
+{$endif}
|
|
|
+ pid:=fpfork;
|
|
|
+ if pid=0 then // We are in the Child
|
|
|
+ begin
|
|
|
+ {$ifdef FPC_USE_FPEXEC}
|
|
|
+ fpexecl('/bin/sh',['-c',Command]);
|
|
|
+ {$else}
|
|
|
+ fpExecve(p^,p,envp);
|
|
|
+ {$endif}
|
|
|
+ fpExit(127); // was exit(127)!! We must exit the Process, not the function
|
|
|
+ end
|
|
|
+ else if (pid<>-1) then // Successfull started
|
|
|
+ Shell:=WaitProcess(pid)
|
|
|
+ else // no success
|
|
|
+ Shell:=-1;
|
|
|
+ {$ifndef FPC_USE_FPEXEC}
|
|
|
+ FreeShellArgV(p);
|
|
|
+ {$ENDIF}
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+{$ifdef FPC_USE_LIBC}
|
|
|
+function xfpsystem(p:pchar):cint; cdecl; external clib name 'system';
|
|
|
+
|
|
|
+Function fpSystem(const Command:AnsiString):cint;
|
|
|
+begin
|
|
|
+ fpsystem:=xfpsystem(pchar(command));
|
|
|
+end;
|
|
|
+{$else}
|
|
|
+Function fpSystem(const Command:AnsiString):cint;
|
|
|
+{
|
|
|
+ AnsiString version of Shell
|
|
|
+}
|
|
|
+var
|
|
|
+ pid,savedpid : cint;
|
|
|
+ pstat : cint;
|
|
|
+ ign,intact,
|
|
|
+ quitact : SigactionRec;
|
|
|
+ newsigblock,
|
|
|
+ oldsigblock : tsigset;
|
|
|
+
|
|
|
+begin { Changes as above }
|
|
|
+ if command='' then exit(1);
|
|
|
+ ign.sa_handler:=SigActionHandler(SIG_IGN);
|
|
|
+ fpsigemptyset(ign.sa_mask);
|
|
|
+ ign.sa_flags:=0;
|
|
|
+ fpsigaction(SIGINT, @ign, @intact);
|
|
|
+ fpsigaction(SIGQUIT, @ign, @quitact);
|
|
|
+ fpsigemptyset(newsigblock);
|
|
|
+ fpsigaddset(newsigblock,SIGCHLD);
|
|
|
+ fpsigprocmask(SIG_BLOCK,{$ifdef ver1_0}@{$endif}newsigblock,{$ifdef ver1_0}@{$endif}oldsigblock);
|
|
|
+ pid:=fpfork;
|
|
|
+ if pid=0 then // We are in the Child
|
|
|
+ begin
|
|
|
+ fpsigaction(SIGINT,@intact,NIL);
|
|
|
+ fpsigaction(SIGQUIT,@quitact,NIL);
|
|
|
+ fpsigprocmask(SIG_SETMASK,@oldsigblock,NIL);
|
|
|
+ fpexecl('/bin/sh',['-c',Command]);
|
|
|
+ fpExit(127); // was exit(127)!! We must exit the Process, not the function
|
|
|
+ end
|
|
|
+ else if (pid<>-1) then // Successfull started
|
|
|
+ begin
|
|
|
+ savedpid:=pid;
|
|
|
+ repeat
|
|
|
+ pid:=fpwaitpid(savedpid,@pstat,0);
|
|
|
+ until (pid<>-1) and (fpgeterrno()<>ESysEintr);
|
|
|
+ if pid=-1 Then
|
|
|
+ fpsystem:=-1
|
|
|
+ else
|
|
|
+ fpsystem:=pstat;
|
|
|
+ end
|
|
|
+ else // no success
|
|
|
+ fpsystem:=-1;
|
|
|
+ fpsigaction(SIGINT,@intact,NIL);
|
|
|
+ fpsigaction(SIGQUIT,@quitact,NIL);
|
|
|
+ fpsigprocmask(SIG_SETMASK,@oldsigblock,NIL);
|
|
|
+end;
|
|
|
+{$endif}
|
|
|
+
|
|
|
+Function WIFSTOPPED(Status: Integer): Boolean;
|
|
|
+begin
|
|
|
+ WIFSTOPPED:=((Status and $FF)=$7F);
|
|
|
+end;
|
|
|
+
|
|
|
+Function W_EXITCODE(ReturnCode, Signal: Integer): Integer;
|
|
|
+begin
|
|
|
+ W_EXITCODE:=(ReturnCode shl 8) or Signal;
|
|
|
+end;
|
|
|
+
|
|
|
+Function W_STOPCODE(Signal: Integer): Integer;
|
|
|
+
|
|
|
+begin
|
|
|
+ W_STOPCODE:=(Signal shl 8) or $7F;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+{$IFNDEF DONT_READ_TIMEZONE}
|
|
|
+{ Include timezone handling routines which use /usr/share/timezone info }
|
|
|
+{$i timezone.inc}
|
|
|
+{$endif}
|
|
|
+{******************************************************************************
|
|
|
+ FileSystem calls
|
|
|
+******************************************************************************}
|
|
|
+
|
|
|
+Function fpFlock (var T : text;mode : cint) : cint;
|
|
|
+begin
|
|
|
+ fpFlock:=fpFlock(TextRec(T).Handle,mode);
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+Function fpFlock (var F : File;mode : cint) :cint;
|
|
|
+begin
|
|
|
+ fpFlock:=fpFlock(FileRec(F).Handle,mode);
|
|
|
+end;
|
|
|
+
|
|
|
+Function SelectText(var T:Text;TimeOut :PTimeval):cint;
|
|
|
+Var
|
|
|
+ F:TfdSet;
|
|
|
+begin
|
|
|
+ if textrec(t).mode=fmclosed then
|
|
|
+ begin
|
|
|
+ fpseterrno(ESysEBADF);
|
|
|
+ exit(-1);
|
|
|
+ end;
|
|
|
+ FpFD_ZERO(f);
|
|
|
+ fpFD_SET(textrec(T).handle,f);
|
|
|
+ if textrec(T).mode=fminput then
|
|
|
+ SelectText:=fpselect(textrec(T).handle+1,@f,nil,nil,TimeOut)
|
|
|
+ else
|
|
|
+ SelectText:=fpselect(textrec(T).handle+1,nil,@f,nil,TimeOut);
|
|
|
+end;
|
|
|
+
|
|
|
+Function SelectText(var T:Text;TimeOut :cint):cint;
|
|
|
+var
|
|
|
+ p : PTimeVal;
|
|
|
+ tv : TimeVal;
|
|
|
+begin
|
|
|
+ if TimeOut=-1 then
|
|
|
+ p:=nil
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ tv.tv_Sec:=Timeout div 1000;
|
|
|
+ tv.tv_Usec:=(Timeout mod 1000)*1000;
|
|
|
+ p:=@tv;
|
|
|
+ end;
|
|
|
+ SelectText:=SelectText(T,p);
|
|
|
+end;
|
|
|
+
|
|
|
+{******************************************************************************
|
|
|
+ Directory
|
|
|
+******************************************************************************}
|
|
|
+
|
|
|
+procedure SeekDir(p:pdir;loc:clong);
|
|
|
+begin
|
|
|
+ if p=nil then
|
|
|
+ begin
|
|
|
+ fpseterrno(ESysEBADF);
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ {$ifndef bsd}
|
|
|
+ p^.dd_nextoff:=fplseek(p^.dd_fd,loc,seek_set);
|
|
|
+ {$endif}
|
|
|
+ p^.dd_size:=0;
|
|
|
+ p^.dd_loc:=0;
|
|
|
+end;
|
|
|
+
|
|
|
+function TellDir(p:pdir):clong;
|
|
|
+begin
|
|
|
+ if p=nil then
|
|
|
+ begin
|
|
|
+ fpseterrno(ESysEBADF);
|
|
|
+ telldir:=-1;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ telldir:=fplseek(p^.dd_fd,0,seek_cur)
|
|
|
+ { We could try to use the nextoff field here, but on my 1.2.13
|
|
|
+ kernel, this gives nothing... This may have to do with
|
|
|
+ the readdir implementation of libc... I also didn't find any trace of
|
|
|
+ the field in the kernel code itself, So I suspect it is an artifact of libc.
|
|
|
+ Michael. }
|
|
|
+end;
|
|
|
+
|
|
|
+{******************************************************************************
|
|
|
+ Pipes/Fifo
|
|
|
+******************************************************************************}
|
|
|
+
|
|
|
+Procedure OpenPipe(var F:Text);
|
|
|
+begin
|
|
|
+ case textrec(f).mode of
|
|
|
+ fmoutput :
|
|
|
+ if textrec(f).userdata[1]<>P_OUT then
|
|
|
+ textrec(f).mode:=fmclosed;
|
|
|
+ fminput :
|
|
|
+ if textrec(f).userdata[1]<>P_IN then
|
|
|
+ textrec(f).mode:=fmclosed;
|
|
|
+ else
|
|
|
+ textrec(f).mode:=fmclosed;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+Function IOPipe(var F:text):cint;
|
|
|
+begin
|
|
|
+ IOPipe:=0;
|
|
|
+ case textrec(f).mode of
|
|
|
+ fmoutput :
|
|
|
+ begin
|
|
|
+ { first check if we need something to write, else we may
|
|
|
+ get a SigPipe when Close() is called (PFV) }
|
|
|
+ if textrec(f).bufpos>0 then
|
|
|
+ IOPipe:=fpwrite(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
|
|
|
+ end;
|
|
|
+ fminput : Begin
|
|
|
+ textrec(f).bufend:=fpread(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
|
|
|
+ IOPipe:=textrec(f).bufend;
|
|
|
+ End;
|
|
|
+ end;
|
|
|
+ textrec(f).bufpos:=0;
|
|
|
+end;
|
|
|
+
|
|
|
+Function FlushPipe(var F:Text):cint;
|
|
|
+begin
|
|
|
+ FlushPipe:=0;
|
|
|
+ if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
|
|
|
+ FlushPipe:=IOPipe(f);
|
|
|
+ textrec(f).bufpos:=0;
|
|
|
+end;
|
|
|
+
|
|
|
+Function ClosePipe(var F:text):cint;
|
|
|
+begin
|
|
|
+ textrec(f).mode:=fmclosed;
|
|
|
+ ClosePipe:=fpclose(textrec(f).handle);
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+Function AssignPipe(var pipe_in,pipe_out:text):cint;
|
|
|
+{
|
|
|
+ Sets up a pair of file variables, which act as a pipe. The first one can
|
|
|
+ be read from, the second one can be written to.
|
|
|
+}
|
|
|
+var
|
|
|
+ f_in,f_out : cint;
|
|
|
+begin
|
|
|
+ if AssignPipe(f_in,f_out)=-1 then
|
|
|
+ exit(-1);
|
|
|
+{ Set up input }
|
|
|
+ Assign(Pipe_in,'');
|
|
|
+ Textrec(Pipe_in).Handle:=f_in;
|
|
|
+ Textrec(Pipe_in).Mode:=fmInput;
|
|
|
+ Textrec(Pipe_in).userdata[1]:=P_IN;
|
|
|
+ TextRec(Pipe_in).OpenFunc:=@OpenPipe;
|
|
|
+ TextRec(Pipe_in).InOutFunc:=@IOPipe;
|
|
|
+ TextRec(Pipe_in).FlushFunc:=@FlushPipe;
|
|
|
+ TextRec(Pipe_in).CloseFunc:=@ClosePipe;
|
|
|
+{ Set up output }
|
|
|
+ Assign(Pipe_out,'');
|
|
|
+ Textrec(Pipe_out).Handle:=f_out;
|
|
|
+ Textrec(Pipe_out).Mode:=fmOutput;
|
|
|
+ Textrec(Pipe_out).userdata[1]:=P_OUT;
|
|
|
+ TextRec(Pipe_out).OpenFunc:=@OpenPipe;
|
|
|
+ TextRec(Pipe_out).InOutFunc:=@IOPipe;
|
|
|
+ TextRec(Pipe_out).FlushFunc:=@FlushPipe;
|
|
|
+ TextRec(Pipe_out).CloseFunc:=@ClosePipe;
|
|
|
+ AssignPipe:=0;
|
|
|
+end;
|
|
|
+
|
|
|
+Function AssignPipe(var pipe_in,pipe_out:file):cint;
|
|
|
+{
|
|
|
+ Sets up a pair of file variables, which act as a pipe. The first one can
|
|
|
+ be read from, the second one can be written to.
|
|
|
+ If the operation was unsuccesful,
|
|
|
+}
|
|
|
+var
|
|
|
+ f_in,f_out : cint;
|
|
|
+begin
|
|
|
+ if AssignPipe(f_in,f_out)=-1 then
|
|
|
+ exit(-1);
|
|
|
+{ Set up input }
|
|
|
+ Assign(Pipe_in,'');
|
|
|
+ Filerec(Pipe_in).Handle:=f_in;
|
|
|
+ Filerec(Pipe_in).Mode:=fmInput;
|
|
|
+ Filerec(Pipe_in).recsize:=1;
|
|
|
+ Filerec(Pipe_in).userdata[1]:=P_IN;
|
|
|
+{ Set up output }
|
|
|
+ Assign(Pipe_out,'');
|
|
|
+ Filerec(Pipe_out).Handle:=f_out;
|
|
|
+ Filerec(Pipe_out).Mode:=fmoutput;
|
|
|
+ Filerec(Pipe_out).recsize:=1;
|
|
|
+ Filerec(Pipe_out).userdata[1]:=P_OUT;
|
|
|
+ AssignPipe:=0;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+Function PCloseText(Var F:text):cint;
|
|
|
+{
|
|
|
+ May not use @PClose due overloading
|
|
|
+}
|
|
|
+begin
|
|
|
+ PCloseText:=PClose(f);
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+function POpen(var F:text;const Prog:String;rw:char):cint;
|
|
|
+{
|
|
|
+ Starts the program in 'Prog' and makes it's input or out put the
|
|
|
+ other end of a pipe. If rw is 'w' or 'W', then whatever is written to
|
|
|
+ F, will be read from stdin by the program in 'Prog'. The inverse is true
|
|
|
+ for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
|
|
|
+ read from 'f'.
|
|
|
+}
|
|
|
+var
|
|
|
+ pipi,
|
|
|
+ pipo : text;
|
|
|
+ pid : pid_t;
|
|
|
+ pl : ^cint;
|
|
|
+{$ifndef FPC_USE_FPEXEC}
|
|
|
+ pp : ppchar;
|
|
|
+{$endif not FPC_USE_FPEXEC}
|
|
|
+ ret : cint;
|
|
|
+begin
|
|
|
+ rw:=upcase(rw);
|
|
|
+ if not (rw in ['R','W']) then
|
|
|
+ begin
|
|
|
+ FpSetErrno(ESysEnoent);
|
|
|
+ exit(-1);
|
|
|
+ end;
|
|
|
+ if AssignPipe(pipi,pipo)=-1 Then
|
|
|
+ Exit(-1);
|
|
|
+ pid:=fpfork; // vfork in FreeBSD.
|
|
|
+ if pid=-1 then
|
|
|
+ begin
|
|
|
+ close(pipi);
|
|
|
+ close(pipo);
|
|
|
+ exit(-1);
|
|
|
+ end;
|
|
|
+ if pid=0 then
|
|
|
+ begin
|
|
|
+ { We're in the child }
|
|
|
+ if rw='W' then
|
|
|
+ begin
|
|
|
+ close(pipo);
|
|
|
+ ret:=fpdup2(pipi,input);
|
|
|
+ close(pipi);
|
|
|
+ if ret=-1 then
|
|
|
+ halt(127);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ close(pipi);
|
|
|
+ ret:=fpdup2(pipo,output);
|
|
|
+ close(pipo);
|
|
|
+ if ret=-1 then
|
|
|
+ halt(127);
|
|
|
+ end;
|
|
|
+ {$ifdef FPC_USE_FPEXEC}
|
|
|
+ fpexecl('/bin/sh',['-c',Prog]);
|
|
|
+ {$else}
|
|
|
+ pp:=createshellargv(prog);
|
|
|
+ fpExecve(pp^,pp,envp);
|
|
|
+ {$endif}
|
|
|
+ halt(127);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ { We're in the parent }
|
|
|
+ if rw='W' then
|
|
|
+ begin
|
|
|
+ close(pipi);
|
|
|
+ f:=pipo;
|
|
|
+ textrec(f).bufptr:=@textrec(f).buffer;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ close(pipo);
|
|
|
+ f:=pipi;
|
|
|
+ textrec(f).bufptr:=@textrec(f).buffer;
|
|
|
+ end;
|
|
|
+ {Save the process ID - needed when closing }
|
|
|
+ pl:=@(textrec(f).userdata[2]);
|
|
|
+ pl^:=pid;
|
|
|
+ textrec(f).closefunc:=@PCloseText;
|
|
|
+ end;
|
|
|
+ ret:=0;
|
|
|
+end;
|
|
|
+
|
|
|
+Function POpen(var F:file;const Prog:String;rw:char):cint;
|
|
|
+{
|
|
|
+ Starts the program in 'Prog' and makes it's input or out put the
|
|
|
+ other end of a pipe. If rw is 'w' or 'W', then whatever is written to
|
|
|
+ F, will be read from stdin by the program in 'Prog'. The inverse is true
|
|
|
+ for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
|
|
|
+ read from 'f'.
|
|
|
+}
|
|
|
+var
|
|
|
+ pipi,
|
|
|
+ pipo : file;
|
|
|
+ pid : cint;
|
|
|
+ pl : ^cint;
|
|
|
+{$ifndef FPC_USE_FPEXEC}
|
|
|
+ p,pp : ppchar;
|
|
|
+ temp : string[255];
|
|
|
+{$endif not FPC_USE_FPEXEC}
|
|
|
+ ret : cint;
|
|
|
+begin
|
|
|
+ rw:=upcase(rw);
|
|
|
+ if not (rw in ['R','W']) then
|
|
|
+ begin
|
|
|
+ FpSetErrno(ESysEnoent);
|
|
|
+ exit(-1);
|
|
|
+ end;
|
|
|
+ ret:=AssignPipe(pipi,pipo);
|
|
|
+ if ret=-1 then
|
|
|
+ exit(-1);
|
|
|
+ pid:=fpfork;
|
|
|
+ if pid=-1 then
|
|
|
+ begin
|
|
|
+ close(pipi);
|
|
|
+ close(pipo);
|
|
|
+ exit(-1);
|
|
|
+ end;
|
|
|
+ if pid=0 then
|
|
|
+ begin
|
|
|
+ { We're in the child }
|
|
|
+ if rw='W' then
|
|
|
+ begin
|
|
|
+ close(pipo);
|
|
|
+ ret:=fpdup2(filerec(pipi).handle,stdinputhandle);
|
|
|
+ close(pipi);
|
|
|
+ if ret=-1 then
|
|
|
+ halt(127);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ close(pipi);
|
|
|
+ ret:=fpdup2(filerec(pipo).handle,stdoutputhandle);
|
|
|
+ close(pipo);
|
|
|
+ if ret=1 then
|
|
|
+ halt(127);
|
|
|
+ end;
|
|
|
+ {$ifdef FPC_USE_FPEXEC}
|
|
|
+ fpexecl('/bin/sh',['-c',Prog]);
|
|
|
+ {$else}
|
|
|
+ getmem(pp,sizeof(pchar)*4);
|
|
|
+ temp:='/bin/sh'#0'-c'#0+prog+#0;
|
|
|
+ p:=pp;
|
|
|
+ p^:=@temp[1];
|
|
|
+ inc(p);
|
|
|
+ p^:=@temp[9];
|
|
|
+ inc(p);
|
|
|
+ p^:=@temp[12];
|
|
|
+ inc(p);
|
|
|
+ p^:=Nil;
|
|
|
+ fpExecve(ansistring('/bin/sh'),pp,envp);
|
|
|
+ {$endif}
|
|
|
+ halt(127);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ { We're in the parent }
|
|
|
+ if rw='W' then
|
|
|
+ begin
|
|
|
+ close(pipi);
|
|
|
+ f:=pipo;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ close(pipo);
|
|
|
+ f:=pipi;
|
|
|
+ end;
|
|
|
+ {Save the process ID - needed when closing }
|
|
|
+ pl:=@(filerec(f).userdata[2]);
|
|
|
+ pl^:=pid;
|
|
|
+ end;
|
|
|
+ POpen:=0;
|
|
|
+end;
|
|
|
+
|
|
|
+Function AssignStream(Var StreamIn,Streamout:text;Const Prog:ansiString;const args : array of ansistring) : cint;
|
|
|
+{
|
|
|
+ Starts the program in 'Prog' and makes its input and output the
|
|
|
+ other end of two pipes, which are the stdin and stdout of a program
|
|
|
+ specified in 'Prog'.
|
|
|
+ streamout can be used to write to the program, streamin can be used to read
|
|
|
+ the output of the program. See the following diagram :
|
|
|
+ Parent Child
|
|
|
+ STreamout --> Input
|
|
|
+ Streamin <-- Output
|
|
|
+ Return value is the process ID of the process being spawned, or -1 in case of failure.
|
|
|
+}
|
|
|
+var
|
|
|
+ pipi,
|
|
|
+ pipo : text;
|
|
|
+ pid : cint;
|
|
|
+ pl : ^cint;
|
|
|
+begin
|
|
|
+ AssignStream:=-1;
|
|
|
+ if AssignPipe(streamin,pipo)=-1 Then
|
|
|
+ exit(-1);
|
|
|
+ if AssignPipe(pipi,streamout)=-1 Then // shouldn't this close streamin and pipo?
|
|
|
+ exit(-1);
|
|
|
+ pid:=fpfork;
|
|
|
+ if pid=-1 then
|
|
|
+ begin
|
|
|
+ close(pipi);
|
|
|
+ close(pipo);
|
|
|
+ close (streamin);
|
|
|
+ close (streamout);
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ if pid=0 then
|
|
|
+ begin
|
|
|
+ { We're in the child }
|
|
|
+ { Close what we don't need }
|
|
|
+ close(streamout);
|
|
|
+ close(streamin);
|
|
|
+ if fpdup2(pipi,input)=-1 Then
|
|
|
+ halt(127);
|
|
|
+ close(pipi);
|
|
|
+ If fpdup2(pipo,output)=-1 Then
|
|
|
+ halt (127);
|
|
|
+ close(pipo);
|
|
|
+ fpExecl(Prog,args);
|
|
|
+ halt(127);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ { we're in the parent}
|
|
|
+ close(pipo);
|
|
|
+ close(pipi);
|
|
|
+ {Save the process ID - needed when closing }
|
|
|
+ pl:=@(textrec(StreamIn).userdata[2]);
|
|
|
+ pl^:=pid;
|
|
|
+ textrec(StreamIn).closefunc:=@PCloseText;
|
|
|
+ {Save the process ID - needed when closing }
|
|
|
+ pl:=@(textrec(StreamOut).userdata[2]);
|
|
|
+ pl^:=pid;
|
|
|
+ textrec(StreamOut).closefunc:=@PCloseText;
|
|
|
+ AssignStream:=Pid;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+Function AssignStream(Var StreamIn,Streamout,streamerr:text;Const Prog:ansiString;const args : array of ansistring) : cint;
|
|
|
+
|
|
|
+{
|
|
|
+ Starts the program in 'prog' and makes its input, output and error output the
|
|
|
+ other end of three pipes, which are the stdin, stdout and stderr of a program
|
|
|
+ specified in 'prog'.
|
|
|
+ StreamOut can be used to write to the program, StreamIn can be used to read
|
|
|
+ the output of the program, StreamErr reads the error output of the program.
|
|
|
+ See the following diagram :
|
|
|
+ Parent Child
|
|
|
+ StreamOut --> StdIn (input)
|
|
|
+ StreamIn <-- StdOut (output)
|
|
|
+ StreamErr <-- StdErr (error output)
|
|
|
+}
|
|
|
+var
|
|
|
+ PipeIn, PipeOut, PipeErr: text;
|
|
|
+ pid: cint;
|
|
|
+ pl: ^cint;
|
|
|
+begin
|
|
|
+ AssignStream := -1;
|
|
|
+
|
|
|
+ // Assign pipes
|
|
|
+ if AssignPipe(StreamIn, PipeOut)=-1 Then
|
|
|
+ Exit(-1);
|
|
|
+
|
|
|
+ If AssignPipe(StreamErr, PipeErr)=-1 Then
|
|
|
+ begin
|
|
|
+ Close(StreamIn);
|
|
|
+ Close(PipeOut);
|
|
|
+ exit(-1);
|
|
|
+ end;
|
|
|
+
|
|
|
+ if AssignPipe(PipeIn, StreamOut)=-1 Then
|
|
|
+ begin
|
|
|
+ Close(StreamIn);
|
|
|
+ Close(PipeOut);
|
|
|
+ Close(StreamErr);
|
|
|
+ Close(PipeErr);
|
|
|
+ exit(-1);
|
|
|
+ end;
|
|
|
+
|
|
|
+ // Fork
|
|
|
+
|
|
|
+ pid := fpFork;
|
|
|
+ if pid=-1 then begin
|
|
|
+ Close(StreamIn);
|
|
|
+ Close(PipeOut);
|
|
|
+ Close(StreamErr);
|
|
|
+ Close(PipeErr);
|
|
|
+ Close(PipeIn);
|
|
|
+ Close(StreamOut);
|
|
|
+ exit(-1);
|
|
|
+ end;
|
|
|
+
|
|
|
+ if pid = 0 then begin
|
|
|
+ // *** We are in the child ***
|
|
|
+ // Close what we don not need
|
|
|
+ Close(StreamOut);
|
|
|
+ Close(StreamIn);
|
|
|
+ Close(StreamErr);
|
|
|
+ // Connect pipes
|
|
|
+ if fpdup2(PipeIn, Input)=-1 Then
|
|
|
+ Halt(127);
|
|
|
+ Close(PipeIn);
|
|
|
+ if fpdup2(PipeOut, Output)=-1 Then
|
|
|
+ Halt(127);
|
|
|
+ Close(PipeOut);
|
|
|
+ if fpdup2(PipeErr, StdErr)=-1 Then
|
|
|
+ Halt(127);
|
|
|
+ Close(PipeErr);
|
|
|
+ // Execute program
|
|
|
+ fpExecl(Prog,args);
|
|
|
+ Halt(127);
|
|
|
+ end else begin
|
|
|
+ // *** We are in the parent ***
|
|
|
+ Close(PipeErr);
|
|
|
+ Close(PipeOut);
|
|
|
+ Close(PipeIn);
|
|
|
+ // Save the process ID - needed when closing
|
|
|
+ pl := @(TextRec(StreamIn).userdata[2]);
|
|
|
+ pl^ := pid;
|
|
|
+ TextRec(StreamIn).closefunc := @PCloseText;
|
|
|
+ // Save the process ID - needed when closing
|
|
|
+ pl := @(TextRec(StreamOut).userdata[2]);
|
|
|
+ pl^ := pid;
|
|
|
+ TextRec(StreamOut).closefunc := @PCloseText;
|
|
|
+ // Save the process ID - needed when closing
|
|
|
+ pl := @(TextRec(StreamErr).userdata[2]);
|
|
|
+ pl^ := pid;
|
|
|
+ TextRec(StreamErr).closefunc := @PCloseText;
|
|
|
+ AssignStream := pid;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{******************************************************************************
|
|
|
+ General information calls
|
|
|
+******************************************************************************}
|
|
|
+
|
|
|
+{$ifdef Linux}
|
|
|
+Function GetDomainName:String; { linux only!}
|
|
|
+// domainname is a glibc extension.
|
|
|
+
|
|
|
+{
|
|
|
+ Get machines domain name. Returns empty string if not set.
|
|
|
+}
|
|
|
+Var
|
|
|
+ Sysn : utsname;
|
|
|
+begin
|
|
|
+ If fpUname(sysn)<>0 then
|
|
|
+ getdomainname:=''
|
|
|
+ else
|
|
|
+ getdomainname:=strpas(@Sysn.domain[0]);
|
|
|
+end;
|
|
|
+{$endif}
|
|
|
+
|
|
|
+{$ifdef BSD}
|
|
|
+
|
|
|
+function intGetDomainName(Name:PChar; NameLen:Cint):cint;
|
|
|
+{$ifndef FPC_USE_LIBC}
|
|
|
+ external name 'FPC_SYSC_GETDOMAINNAME';
|
|
|
+{$else FPC_USE_LIBC}
|
|
|
+ cdecl; external clib name 'getdomainname';
|
|
|
+{$endif FPC_USE_LIBC}
|
|
|
+
|
|
|
+Function GetDomainName:String; { linux only!}
|
|
|
+// domainname is a glibc extension.
|
|
|
+
|
|
|
+{
|
|
|
+ Get machines domain name. Returns empty string if not set.
|
|
|
+}
|
|
|
+
|
|
|
+begin
|
|
|
+ if intGetDomainName(@getdomainname[1],255)=-1 then
|
|
|
+ getdomainname:=''
|
|
|
+ else
|
|
|
+ getdomainname[0]:=chr(strlen(@getdomainname[1]));
|
|
|
+end;
|
|
|
+{$endif}
|
|
|
+
|
|
|
+
|
|
|
+Function GetHostName:String;
|
|
|
+{
|
|
|
+ Get machines name. Returns empty string if not set.
|
|
|
+}
|
|
|
+Var
|
|
|
+ Sysn : utsname;
|
|
|
+begin
|
|
|
+ If fpuname(sysn)=-1 then
|
|
|
+ gethostname:=''
|
|
|
+ else
|
|
|
+ gethostname:=strpas(@Sysn.nodename[0]);
|
|
|
+end;
|
|
|
+
|
|
|
+{******************************************************************************
|
|
|
+ Signal handling calls
|
|
|
+******************************************************************************}
|
|
|
+
|
|
|
+procedure SigRaise(sig:integer);
|
|
|
+begin
|
|
|
+ fpKill(fpGetPid,Sig);
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+{******************************************************************************
|
|
|
+ Utility calls
|
|
|
+******************************************************************************}
|
|
|
+
|
|
|
+Function FSearch(const path:AnsiString;dirlist:Ansistring;CurrentDirStrategy:TFSearchOption):AnsiString;
|
|
|
+{
|
|
|
+ Searches for a file 'path' in the list of direcories in 'dirlist'.
|
|
|
+ returns an empty string if not found. Wildcards are NOT allowed.
|
|
|
+ If dirlist is empty, it is set to '.'
|
|
|
+
|
|
|
+This function tries to make FSearch use ansistrings, and decrease
|
|
|
+stringhandling overhead at the same time.
|
|
|
+
|
|
|
+}
|
|
|
+Var
|
|
|
+ mydir,NewDir : ansistring;
|
|
|
+ p1 : cint;
|
|
|
+ Info : Stat;
|
|
|
+ i,j : cint;
|
|
|
+ p : pchar;
|
|
|
+Begin
|
|
|
+
|
|
|
+ if CurrentDirStrategy=CurrentDirectoryFirst Then
|
|
|
+ Dirlist:='.:'+dirlist; {Make sure current dir is first to be searched.}
|
|
|
+ if CurrentDirStrategy=CurrentDirectoryLast Then
|
|
|
+ Dirlist:=dirlist+':.'; {Make sure current dir is last to be searched.}
|
|
|
+
|
|
|
+{Replace ':' and ';' with #0}
|
|
|
+
|
|
|
+ for p1:=1 to length(dirlist) do
|
|
|
+ if (dirlist[p1]=':') or (dirlist[p1]=';') then
|
|
|
+ dirlist[p1]:=#0;
|
|
|
+
|
|
|
+{Check for WildCards}
|
|
|
+ If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
|
|
|
+ FSearch:='' {No wildcards allowed in these things.}
|
|
|
+ Else
|
|
|
+ Begin
|
|
|
+ p:=pchar(dirlist);
|
|
|
+ i:=length(dirlist);
|
|
|
+ j:=1;
|
|
|
+ Repeat
|
|
|
+ mydir:=ansistring(p);
|
|
|
+ if (length(mydir)>0) and (mydir[length(mydir)]<>'/') then
|
|
|
+ mydir:=mydir+'/';
|
|
|
+ NewDir:=mydir+Path;
|
|
|
+ if (FpStat(NewDir,Info)>=0) and
|
|
|
+ (not fpS_ISDIR(Info.st_Mode)) then
|
|
|
+ Begin
|
|
|
+ If Pos('./',NewDir)=1 Then
|
|
|
+ Delete(NewDir,1,2);
|
|
|
+ {DOS strips off an initial .\}
|
|
|
+ End
|
|
|
+ Else
|
|
|
+ NewDir:='';
|
|
|
+ while (j<=i) and (p^<>#0) do begin inc(j); inc(p); end;
|
|
|
+ if p^=#0 then inc(p);
|
|
|
+ Until (j>=i) or (Length(NewDir) > 0);
|
|
|
+ FSearch:=NewDir;
|
|
|
+ End;
|
|
|
+End;
|
|
|
+
|
|
|
+Function FSearch(const path:AnsiString;dirlist:Ansistring):AnsiString;
|
|
|
+
|
|
|
+Begin
|
|
|
+ FSearch:=FSearch(path,dirlist,CurrentDirectoryFirst);
|
|
|
+End;
|
|
|
+
|
|
|
+{--------------------------------
|
|
|
+ Stat.Mode Macro's
|
|
|
+--------------------------------}
|
|
|
+
|
|
|
+Initialization
|
|
|
+{$IFNDEF DONT_READ_TIMEZONE}
|
|
|
+ InitLocalTime;
|
|
|
+{$endif}
|
|
|
+finalization
|
|
|
+{$IFNDEF DONT_READ_TIMEZONE}
|
|
|
+ DoneLocalTime;
|
|
|
+{$endif}
|
|
|
+End.
|
|
|
+
|
|
|
+{
|
|
|
+ $Log: unix.pp,v $
|
|
|
+ Revision 1.85 2005/03/25 22:53:39 jonas
|
|
|
+ * fixed several warnings and notes about unused variables (mainly) or
|
|
|
+ uninitialised use of variables/function results (a few)
|
|
|
+
|
|
|
+ Revision 1.84 2005/02/14 17:13:31 peter
|
|
|
+ * truncate log
|
|
|
+
|
|
|
+ Revision 1.83 2005/02/13 21:47:56 peter
|
|
|
+ * include file cleanup part 2
|
|
|
+
|
|
|
+ Revision 1.82 2005/02/13 20:01:38 peter
|
|
|
+ * include file cleanup
|
|
|
+
|
|
|
+ Revision 1.81 2005/02/06 11:20:52 peter
|
|
|
+ * threading in system unit
|
|
|
+ * removed systhrds unit
|
|
|
+
|
|
|
+ Revision 1.80 2005/01/30 18:01:15 peter
|
|
|
+ * signal cleanup for linux
|
|
|
+ * sigactionhandler instead of tsigaction for bsds
|
|
|
+ * sigcontext moved to cpu dir
|
|
|
+
|
|
|
+ Revision 1.79 2005/01/22 20:56:11 michael
|
|
|
+ + Patch for intFpExecVEMaybeP to use the right path (From Colin Western)
|
|
|
+
|
|
|
+}
|
florian