unix.pp 43 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Michael Van Canneyt,
  5. BSD parts (c) 2000 by Marco van de Voort
  6. members of the Free Pascal development team.
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY;without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. Unit Unix;
  14. Interface
  15. Uses UnixUtil,BaseUnix;
  16. {// i ostypes.inc}
  17. { Get Types and Constants }
  18. {$i sysconst.inc}
  19. {$i systypes.inc}
  20. { Get System call numbers and error-numbers}
  21. {$i sysnr.inc}
  22. {$i errno.inc}
  23. {$I signal.inc}
  24. {$i ostypes.inc}
  25. {********************
  26. Process
  27. ********************}
  28. const
  29. { For getting/setting priority }
  30. Prio_Process = 0;
  31. Prio_PGrp = 1;
  32. Prio_User = 2;
  33. {$ifdef Solaris}
  34. WNOHANG = $100;
  35. WUNTRACED = $4;
  36. {$ELSE}
  37. WNOHANG = $1;
  38. WUNTRACED = $2;
  39. __WCLONE = $80000000;
  40. {$ENDIF}
  41. {********************
  42. File
  43. ********************}
  44. Const
  45. P_IN = 1;
  46. P_OUT = 2;
  47. Const
  48. LOCK_SH = 1;
  49. LOCK_EX = 2;
  50. LOCK_UN = 8;
  51. LOCK_NB = 4;
  52. Type
  53. Tpipe = array[1..2] of cint;
  54. pglob = ^tglob;
  55. tglob = record
  56. name : pchar;
  57. next : pglob;
  58. end;
  59. const
  60. { For File control mechanism }
  61. F_GetFd = 1;
  62. F_SetFd = 2;
  63. F_GetFl = 3;
  64. F_SetFl = 4;
  65. {$ifdef Solaris}
  66. F_DupFd = 0;
  67. F_Dup2Fd = 9;
  68. F_GetOwn = 23;
  69. F_SetOwn = 24;
  70. F_GetLk = 14;
  71. F_SetLk = 6;
  72. F_SetLkW = 7;
  73. F_FreeSp = 11;
  74. {$else}
  75. F_GetLk = 5;
  76. F_SetLk = 6;
  77. F_SetLkW = 7;
  78. F_SetOwn = 8;
  79. F_GetOwn = 9;
  80. {$endif}
  81. {********************
  82. IOCtl(TermIOS)
  83. ********************}
  84. {Is too freebsd/Linux specific}
  85. {$I termios.inc}
  86. {******************************************************************************
  87. Procedure/Functions
  88. ******************************************************************************}
  89. {**************************
  90. Time/Date Handling
  91. ***************************}
  92. var
  93. tzdaylight : boolean;
  94. tzname : array[boolean] of pchar;
  95. { timezone support }
  96. procedure GetLocalTimezone(timer:cint;var leap_correct,leap_hit:cint);
  97. procedure GetLocalTimezone(timer:cint);
  98. procedure ReadTimezoneFile(fn:string);
  99. function GetTimezoneFile:string;
  100. Function GetEpochTime: cint;
  101. procedure GetTime(var hour,min,sec,msec,usec:word);
  102. procedure GetTime(var hour,min,sec,sec100:word);
  103. procedure GetTime(var hour,min,sec:word);
  104. Procedure GetDate(Var Year,Month,Day:Word);
  105. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  106. function SetTime(Hour,Min,Sec:word) : Boolean;
  107. function SetDate(Year,Month,Day:Word) : Boolean;
  108. function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
  109. {**************************
  110. Process Handling
  111. ***************************}
  112. function CreateShellArgV(const prog:string):ppchar;
  113. function CreateShellArgV(const prog:Ansistring):ppchar;
  114. //Procedure Execve(Path: pathstr;args:ppchar;ep:ppchar);
  115. //Procedure Execve(Path: AnsiString;args:ppchar;ep:ppchar);
  116. //Procedure Execve(path: pchar;args:ppchar;ep:ppchar);
  117. Function Execv(const path:pathstr;args:ppchar):cint;
  118. Function Execv(const path: AnsiString;args:ppchar):cint;
  119. Function Execvp(Path: Pathstr;Args:ppchar;Ep:ppchar):cint;
  120. Function Execvp(Path: AnsiString; Args:ppchar;Ep:ppchar):cint;
  121. Function Execl(const Todo: String):cint;
  122. Function Execl(const Todo: Ansistring):cint;
  123. Function Execle(Todo: String;Ep:ppchar):cint;
  124. Function Execle(Todo: AnsiString;Ep:ppchar):cint;
  125. Function Execlp(Todo: string;Ep:ppchar):cint;
  126. Function Execlp(Todo: Ansistring;Ep:ppchar):cint;
  127. Function Shell(const Command:String):cint;
  128. Function Shell(const Command:AnsiString):cint;
  129. {Clone for FreeBSD is copied from the LinuxThread port, and rfork based}
  130. function Clone(func:TCloneFunc;sp:pointer;flags:cint;args:pointer):cint;
  131. 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}
  132. Function WIFSTOPPED(Status: Integer): Boolean;
  133. Function W_EXITCODE(ReturnCode, Signal: Integer): Integer;
  134. Function W_STOPCODE(Signal: Integer): Integer;
  135. {**************************
  136. File Handling
  137. ***************************}
  138. Function fdFlush (fd : cint) : cint;
  139. Function Flock (fd,mode : cint) : cint ;
  140. Function Flock (var T : text;mode : cint) : cint;
  141. Function Flock (var F : File;mode : cint) : cint;
  142. Function StatFS(Path:Pathstr;Var Info:tstatfs):cint;
  143. Function fStatFS(Fd: cint;Var Info:tstatfs):cint;
  144. Function SelectText(var T:Text;TimeOut :PTimeVal):cint;
  145. Function SelectText(var T:Text;TimeOut :cint):cint;
  146. {**************************
  147. Directory Handling
  148. ***************************}
  149. procedure SeekDir(p:pdir;loc:clong);
  150. function TellDir(p:pdir):clong;
  151. {**************************
  152. Pipe/Fifo/Stream
  153. ***************************}
  154. Function AssignPipe(var pipe_in,pipe_out:cint):cint;
  155. Function AssignPipe(var pipe_in,pipe_out:text):cint;
  156. Function AssignPipe(var pipe_in,pipe_out:file):cint;
  157. Function PClose(Var F:text) : cint;
  158. Function PClose(Var F:file) : cint;
  159. Function POpen(var F:text;const Prog:String;rw:char):cint;
  160. Function POpen(var F:file;const Prog:String;rw:char):cint;
  161. function AssignStream(Var StreamIn,Streamout:text;Const Prog:String) : cint;
  162. function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): cint;
  163. {$ifndef BSD}
  164. Function GetDomainName:String;
  165. Function GetHostName:String;
  166. {$endif}
  167. {**************************
  168. IOCtl/Termios Functions
  169. ***************************}
  170. Function TCGetAttr (fd:cint;var tios:TermIOS):cint;
  171. Function TCSetAttr (fd:cint;OptAct:cint;const tios:TermIOS):cint;
  172. Procedure CFSetISpeed (var tios:TermIOS;speed:Cardinal);
  173. Procedure CFSetOSpeed (var tios:TermIOS;speed:Cardinal);
  174. Procedure CFMakeRaw (var tios:TermIOS);
  175. Function TCSendBreak (fd,duration:cint):cint;
  176. Function TCSetPGrp (fd,id:cint) :cint;
  177. Function TCGetPGrp (fd:cint;var id:cint):cint;
  178. Function TCFlush (fd,qsel:cint):cint;
  179. Function TCDrain (fd:cint) :cint;
  180. Function TCFlow (fd,act:cint) :cint;
  181. Function IsATTY (Handle:cint) :cint;
  182. Function IsATTY (var f:text) :cint;
  183. function TTYname (Handle:cint):string;
  184. function TTYname (var F:Text) :string;
  185. {**************************
  186. Memory functions
  187. ***************************}
  188. const
  189. PROT_READ = $1; { page can be read }
  190. PROT_WRITE = $2; { page can be written }
  191. PROT_EXEC = $4; { page can be executed }
  192. PROT_NONE = $0; { page can not be accessed }
  193. MAP_SHARED = $1; { Share changes }
  194. // MAP_PRIVATE = $2; { Changes are private }
  195. MAP_TYPE = $f; { Mask for type of mapping }
  196. MAP_FIXED = $10; { Interpret addr exactly }
  197. // MAP_ANONYMOUS = $20; { don't use a file }
  198. MAP_GROWSDOWN = $100; { stack-like segment }
  199. MAP_DENYWRITE = $800; { ETXTBSY }
  200. MAP_EXECUTABLE = $1000; { mark it as an executable }
  201. MAP_LOCKED = $2000; { pages are locked }
  202. MAP_NORESERVE = $4000; { don't check for reservations }
  203. {**************************
  204. Utility functions
  205. ***************************}
  206. Function FExpand(Const Path: PathStr):PathStr;
  207. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  208. Function Glob(Const path:pathstr):pglob;
  209. Procedure Globfree(var p:pglob);
  210. {Filedescriptorsets}
  211. {Stat.Mode Types}
  212. procedure SigRaise(sig:integer);
  213. {******************************************************************************
  214. Implementation
  215. ******************************************************************************}
  216. {$i unxsysch.inc}
  217. Implementation
  218. Uses Strings;
  219. {$i syscallh.inc}
  220. {$i ossysch.inc}
  221. {$i unxsysc.inc}
  222. { Get the definitions of textrec and filerec }
  223. {$i textrec.inc}
  224. {$i filerec.inc}
  225. { Raw System calls are in Syscalls.inc}
  226. {$ifdef Linux} // Linux has more "oldlinux" compability.
  227. {$i sysc11.inc}
  228. {$else}
  229. {$i syscalls.inc}
  230. {$endif}
  231. {$i unixsysc.inc} {Syscalls only used in unit Unix/Linux}
  232. Function getenv(name:string):Pchar; external name 'FPC_SYSC_FPGETENV';
  233. {******************************************************************************
  234. Process related calls
  235. ******************************************************************************}
  236. { Most calls of WaitPID do not handle the result correctly, this funktion treats errors more correctly }
  237. 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}
  238. var ret,r,s : cint;
  239. begin
  240. s:=$7F00;
  241. repeat
  242. r:=fpWaitPid(Pid,@s,0);
  243. if (r=-1) and (fpgeterrno=ESysEIntr) Then
  244. r:=0;
  245. until (r<>-1);
  246. if (r=-1) or (r=0) then // 0 is not a valid return and should never occur (it means status invalid when using WNOHANG)
  247. WaitProcess:=-1 // return -1 to indicate an error. fpwaitpid updated it.
  248. else
  249. begin
  250. {$ifndef Solaris}
  251. { at least correct for Linux and Darwin (JM) }
  252. if (s and $7F)=0 then // Only this is a valid returncode
  253. {$else}
  254. if (s and $FF)=0 then // Only this is a valid returncode
  255. {$endif}
  256. WaitProcess:=s shr 8
  257. else if (s>0) then // Until now there is not use of the highest bit , but check this for the future
  258. WaitProcess:=-s // normal case
  259. else
  260. WaitProcess:=s; // s<0 should not occur, but wie return also a negativ value
  261. end;
  262. end;
  263. function InternalCreateShellArgV(cmd:pChar; len:cint):ppchar;
  264. {
  265. Create an argv which executes a command in a shell using /bin/sh -c
  266. }
  267. const Shell = '/bin/sh'#0'-c'#0;
  268. var
  269. pp,p : ppchar;
  270. // temp : string; !! Never pass a local var back!!
  271. begin
  272. getmem(pp,4*4);
  273. p:=pp;
  274. p^:=@Shell[1];
  275. inc(p);
  276. p^:=@Shell[9];
  277. inc(p);
  278. getmem(p^,len+1);
  279. move(cmd^,p^^,len);
  280. pchar(p^)[len]:=#0;
  281. inc(p);
  282. p^:=Nil;
  283. InternalCreateShellArgV:=pp;
  284. end;
  285. function CreateShellArgV(const prog:string):ppchar;
  286. begin
  287. CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog));
  288. end;
  289. function CreateShellArgV(const prog:Ansistring):ppchar;
  290. {
  291. Create an argv which executes a command in a shell using /bin/sh -c
  292. using a AnsiString;
  293. }
  294. begin
  295. CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog)); // if ppc works like delphi this also work when @prog[1] is invalid (len=0)
  296. end;
  297. procedure FreeShellArgV(p:ppchar);
  298. begin
  299. if (p<>nil) then begin
  300. freemem(p[2]);
  301. freemem(p);
  302. end;
  303. end;
  304. Function Execv(const path: AnsiString;args:ppchar):cint;
  305. {
  306. Overloaded ansistring version.
  307. }
  308. begin
  309. Execv:=fpExecVe(Path,Args,envp);
  310. end;
  311. Function Execvp(Path: AnsiString; Args:ppchar;Ep:ppchar):cint;
  312. {
  313. Overloaded ansistring version
  314. }
  315. var
  316. thepath : Ansistring;
  317. begin
  318. if path[1]<>'/' then
  319. begin
  320. Thepath:=strpas(fpgetenv('PATH'));
  321. if thepath='' then
  322. thepath:='.';
  323. Path:=FSearch(path,thepath)
  324. end
  325. else
  326. Path:='';
  327. if Path='' then
  328. Begin
  329. fpsetErrno(ESysEnoEnt);
  330. Exit(-1);
  331. end
  332. else
  333. Execvp:=fpExecve(Path,args,ep);
  334. end;
  335. Function Execv(const path:pathstr;args:ppchar):cint;
  336. {
  337. Replaces the current program by the program specified in path,
  338. arguments in args are passed to Execve.
  339. the current environment is passed on.
  340. }
  341. begin
  342. Execv:=fpExecve(path,args,envp);
  343. end;
  344. Function Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar):cint;
  345. {
  346. This does the same as Execve, only it searches the PATH environment
  347. for the place of the Executable, except when Path starts with a slash.
  348. if the PATH environment variable is unavailable, the path is set to '.'
  349. }
  350. var
  351. thepath : string;
  352. begin
  353. if path[1]<>'/' then
  354. begin
  355. Thepath:=strpas(fpgetenv('PATH'));
  356. if thepath='' then
  357. thepath:='.';
  358. Path:=FSearch(path,thepath)
  359. end
  360. else
  361. Path:='';
  362. if Path='' then
  363. Begin
  364. fpsetErrno(ESysEnoEnt);
  365. Exit(-1);
  366. end
  367. else
  368. execvp:=fpExecve(Path,args,ep);
  369. end;
  370. Function Execle(Todo:string;Ep:ppchar):cint;
  371. {
  372. This procedure takes the string 'Todo', parses it for command and
  373. command options, and Executes the command with the given options.
  374. The string 'Todo' shoud be of the form 'command options', options
  375. separated by commas.
  376. the PATH environment is not searched for 'command'.
  377. The specified environment(in 'ep') is passed on to command
  378. }
  379. var
  380. p : ppchar;
  381. begin
  382. p:=StringToPPChar(ToDo);
  383. if (p=nil) or (p^=nil) then
  384. Begin
  385. fpsetErrno(ESysEnoEnt);
  386. Exit(-1);
  387. end
  388. else
  389. execle:=fpExecVE(p^,p,EP);
  390. end;
  391. function Execle(Todo:AnsiString;Ep:ppchar):cint;
  392. {
  393. This procedure takes the string 'Todo', parses it for command and
  394. command options, and Executes the command with the given options.
  395. The string 'Todo' shoud be of the form 'command options', options
  396. separated by commas.
  397. the PATH environment is not searched for 'command'.
  398. The specified environment(in 'ep') is passed on to command
  399. }
  400. var
  401. p : ppchar;
  402. begin
  403. p:=StringToPPChar(ToDo);
  404. if (p=nil) or (p^=nil) then
  405. Begin
  406. fpsetErrno(ESysEnoEnt);
  407. Exit(-1);
  408. end;
  409. ExecLe:=fpExecVE(p^,p,EP);
  410. end;
  411. Function Execl(const Todo:string):cint;
  412. {
  413. This procedure takes the string 'Todo', parses it for command and
  414. command options, and Executes the command with the given options.
  415. The string 'Todo' shoud be of the form 'command options', options
  416. separated by commas.
  417. the PATH environment is not searched for 'command'.
  418. The current environment is passed on to command
  419. }
  420. begin
  421. Execl:=ExecLE(ToDo,EnvP);
  422. end;
  423. Function Execlp(Todo:string;Ep:ppchar):cint;
  424. {
  425. This procedure takes the string 'Todo', parses it for command and
  426. command options, and Executes the command with the given options.
  427. The string 'Todo' shoud be of the form 'command options', options
  428. separated by commas.
  429. the PATH environment is searched for 'command'.
  430. The specified environment (in 'ep') is passed on to command
  431. }
  432. var
  433. p : ppchar;
  434. begin
  435. p:=StringToPPchar(todo);
  436. if (p=nil) or (p^=nil) then
  437. Begin
  438. fpsetErrno(ESysEnoEnt);
  439. Exit(-1);
  440. end;
  441. Execlp:=ExecVP(StrPas(p^),p,EP);
  442. end;
  443. Function Execlp(Todo: Ansistring;Ep:ppchar):cint;
  444. {
  445. Overloaded ansistring version.
  446. }
  447. var
  448. p : ppchar;
  449. begin
  450. p:=StringToPPchar(todo);
  451. if (p=nil) or (p^=nil) then
  452. Begin
  453. fpsetErrno(ESysEnoEnt);
  454. Exit(-1);
  455. end;
  456. execlp:=ExecVP(StrPas(p^),p,EP);
  457. end;
  458. Function Shell(const Command:String):cint;
  459. {
  460. Executes the shell, and passes it the string Command. (Through /bin/sh -c)
  461. The current environment is passed to the shell.
  462. It waits for the shell to exit, and returns its exit status.
  463. If the Exec call failed exit status 127 is reported.
  464. }
  465. { Changed the structure:
  466. - the previous version returns an undefinied value if fork fails
  467. - it returns the status of Waitpid instead of the Process returnvalue (see the doc to Shell)
  468. - it uses exit(127) not ExitProc (The Result in pp386: going on Compiling in 2 processes!)
  469. - ShellArgs are now released
  470. - The Old CreateShellArg gives back pointers to a local var
  471. }
  472. var
  473. p : ppchar;
  474. pid : cint;
  475. begin
  476. p:=CreateShellArgv(command);
  477. pid:=fpfork;
  478. if pid=0 then // We are in the Child
  479. begin
  480. {This is the child.}
  481. fpExecve(p^,p,envp);
  482. fpExit(127); // was Exit(127)
  483. end
  484. else if (pid<>-1) then // Successfull started
  485. Shell:=WaitProcess(pid)
  486. else // no success
  487. Shell:=-1; // indicate an error
  488. FreeShellArgV(p);
  489. end;
  490. Function Shell(const Command:AnsiString):cint;
  491. {
  492. AnsiString version of Shell
  493. }
  494. var
  495. p : ppchar;
  496. pid : cint;
  497. begin { Changes as above }
  498. p:=CreateShellArgv(command);
  499. pid:=fpfork;
  500. if pid=0 then // We are in the Child
  501. begin
  502. fpExecve(p^,p,envp);
  503. fpExit(127); // was exit(127)!! We must exit the Process, not the function
  504. end
  505. else if (pid<>-1) then // Successfull started
  506. Shell:=WaitProcess(pid)
  507. else // no success
  508. Shell:=-1;
  509. FreeShellArgV(p);
  510. end;
  511. Function WIFSTOPPED(Status: Integer): Boolean;
  512. begin
  513. WIFSTOPPED:=((Status and $FF)=$7F);
  514. end;
  515. Function W_EXITCODE(ReturnCode, Signal: Integer): Integer;
  516. begin
  517. W_EXITCODE:=(ReturnCode shl 8) or Signal;
  518. end;
  519. Function W_STOPCODE(Signal: Integer): Integer;
  520. begin
  521. W_STOPCODE:=(Signal shl 8) or $7F;
  522. end;
  523. {******************************************************************************
  524. Date and Time related calls
  525. ******************************************************************************}
  526. Function GetEpochTime: cint;
  527. {
  528. Get the number of seconds since 00:00, January 1 1970, GMT
  529. the time NOT corrected any way
  530. }
  531. begin
  532. GetEpochTime:=fptime;
  533. end;
  534. procedure GetTime(var hour,min,sec,msec,usec:word);
  535. {
  536. Gets the current time, adjusted to local time
  537. }
  538. var
  539. year,day,month:Word;
  540. tz:timeval;
  541. begin
  542. fpgettimeofday(@tz,nil);
  543. EpochToLocal(tz.tv_sec,year,month,day,hour,min,sec);
  544. msec:=tz.tv_usec div 1000;
  545. usec:=tz.tv_usec mod 1000;
  546. end;
  547. procedure GetTime(var hour,min,sec,sec100:word);
  548. {
  549. Gets the current time, adjusted to local time
  550. }
  551. var
  552. usec : word;
  553. begin
  554. gettime(hour,min,sec,sec100,usec);
  555. sec100:=sec100 div 10;
  556. end;
  557. Procedure GetTime(Var Hour,Min,Sec:Word);
  558. {
  559. Gets the current time, adjusted to local time
  560. }
  561. var
  562. msec,usec : Word;
  563. Begin
  564. gettime(hour,min,sec,msec,usec);
  565. End;
  566. Procedure GetDate(Var Year,Month,Day:Word);
  567. {
  568. Gets the current date, adjusted to local time
  569. }
  570. var
  571. hour,minute,second : word;
  572. Begin
  573. EpochToLocal(fptime,year,month,day,hour,minute,second);
  574. End;
  575. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  576. {
  577. Gets the current date, adjusted to local time
  578. }
  579. Begin
  580. EpochToLocal(fptime,year,month,day,hour,minute,second);
  581. End;
  582. {$ifndef BSD}
  583. {$ifdef linux}
  584. Function stime (t : cint) : Boolean;
  585. begin
  586. stime:=do_SysCall(Syscall_nr_stime,cint(@t))=0;
  587. end;
  588. {$endif}
  589. {$endif}
  590. {$ifdef BSD}
  591. Function stime (t : cint) : Boolean;
  592. begin
  593. end;
  594. {$endif}
  595. Function SetTime(Hour,Min,Sec:word) : boolean;
  596. var
  597. Year, Month, Day : Word;
  598. begin
  599. GetDate (Year, Month, Day);
  600. SetTime:=stime ( LocalToEpoch ( Year, Month, Day, Hour, Min, Sec ) );
  601. end;
  602. Function SetDate(Year,Month,Day:Word) : boolean;
  603. var
  604. Hour, Minute, Second, Sec100 : Word;
  605. begin
  606. GetTime ( Hour, Minute, Second, Sec100 );
  607. SetDate:=stime ( LocalToEpoch ( Year, Month, Day, Hour, Minute, Second ) );
  608. end;
  609. Function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
  610. begin
  611. SetDateTime:=stime ( LocalToEpoch ( Year, Month, Day, Hour, Minute, Second ) );
  612. end;
  613. { Include timezone handling routines which use /usr/share/timezone info }
  614. {$i timezone.inc}
  615. {******************************************************************************
  616. FileSystem calls
  617. ******************************************************************************}
  618. Function Execl(const Todo:Ansistring):cint;
  619. {
  620. Overloaded AnsiString Version of ExecL.
  621. }
  622. begin
  623. Execl:=ExecLE(ToDo,EnvP);
  624. end;
  625. Function Flock (var T : text;mode : cint) : cint;
  626. begin
  627. Flock:=Flock(TextRec(T).Handle,mode);
  628. end;
  629. Function Flock (var F : File;mode : cint) :cint;
  630. begin
  631. Flock:=Flock(FileRec(F).Handle,mode);
  632. end;
  633. Function SelectText(var T:Text;TimeOut :PTimeval):cint;
  634. Var
  635. F:TfdSet;
  636. begin
  637. if textrec(t).mode=fmclosed then
  638. begin
  639. fpseterrno(ESysEBADF);
  640. exit(-1);
  641. end;
  642. FpFD_ZERO(f);
  643. fpFD_SET(textrec(T).handle,f);
  644. if textrec(T).mode=fminput then
  645. SelectText:=fpselect(textrec(T).handle+1,@f,nil,nil,TimeOut)
  646. else
  647. SelectText:=fpselect(textrec(T).handle+1,nil,@f,nil,TimeOut);
  648. end;
  649. Function SelectText(var T:Text;TimeOut :cint):cint;
  650. var
  651. p : PTimeVal;
  652. tv : TimeVal;
  653. begin
  654. if TimeOut=-1 then
  655. p:=nil
  656. else
  657. begin
  658. tv.tv_Sec:=Timeout div 1000;
  659. tv.tv_Usec:=(Timeout mod 1000)*1000;
  660. p:=@tv;
  661. end;
  662. SelectText:=SelectText(T,p);
  663. end;
  664. {******************************************************************************
  665. Directory
  666. ******************************************************************************}
  667. procedure SeekDir(p:pdir;loc:clong);
  668. begin
  669. if p=nil then
  670. begin
  671. fpseterrno(ESysEBADF);
  672. exit;
  673. end;
  674. {$ifndef bsd}
  675. p^.dd_nextoff:=fplseek(p^.dd_fd,loc,seek_set);
  676. {$endif}
  677. p^.dd_size:=0;
  678. p^.dd_loc:=0;
  679. end;
  680. function TellDir(p:pdir):clong;
  681. begin
  682. if p=nil then
  683. begin
  684. fpseterrno(ESysEBADF);
  685. telldir:=-1;
  686. exit;
  687. end;
  688. telldir:=fplseek(p^.dd_fd,0,seek_cur)
  689. { We could try to use the nextoff field here, but on my 1.2.13
  690. kernel, this gives nothing... This may have to do with
  691. the readdir implementation of libc... I also didn't find any trace of
  692. the field in the kernel code itself, So I suspect it is an artifact of libc.
  693. Michael. }
  694. end;
  695. {******************************************************************************
  696. Pipes/Fifo
  697. ******************************************************************************}
  698. Procedure OpenPipe(var F:Text);
  699. begin
  700. case textrec(f).mode of
  701. fmoutput :
  702. if textrec(f).userdata[1]<>P_OUT then
  703. textrec(f).mode:=fmclosed;
  704. fminput :
  705. if textrec(f).userdata[1]<>P_IN then
  706. textrec(f).mode:=fmclosed;
  707. else
  708. textrec(f).mode:=fmclosed;
  709. end;
  710. end;
  711. Function IOPipe(var F:text):cint;
  712. begin
  713. IOPipe:=0;
  714. case textrec(f).mode of
  715. fmoutput :
  716. begin
  717. { first check if we need something to write, else we may
  718. get a SigPipe when Close() is called (PFV) }
  719. if textrec(f).bufpos>0 then
  720. IOPipe:=fpwrite(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
  721. end;
  722. fminput : Begin
  723. textrec(f).bufend:=fpread(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
  724. IOPipe:=textrec(f).bufend;
  725. End;
  726. end;
  727. textrec(f).bufpos:=0;
  728. end;
  729. Function FlushPipe(var F:Text):cint;
  730. begin
  731. FlushPipe:=0;
  732. if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
  733. FlushPipe:=IOPipe(f);
  734. textrec(f).bufpos:=0;
  735. end;
  736. Function ClosePipe(var F:text):cint;
  737. begin
  738. textrec(f).mode:=fmclosed;
  739. ClosePipe:=fpclose(textrec(f).handle);
  740. end;
  741. Function AssignPipe(var pipe_in,pipe_out:text):cint;
  742. {
  743. Sets up a pair of file variables, which act as a pipe. The first one can
  744. be read from, the second one can be written to.
  745. }
  746. var
  747. f_in,f_out : cint;
  748. begin
  749. if AssignPipe(f_in,f_out)=-1 then
  750. exit(-1);
  751. { Set up input }
  752. Assign(Pipe_in,'');
  753. Textrec(Pipe_in).Handle:=f_in;
  754. Textrec(Pipe_in).Mode:=fmInput;
  755. Textrec(Pipe_in).userdata[1]:=P_IN;
  756. TextRec(Pipe_in).OpenFunc:=@OpenPipe;
  757. TextRec(Pipe_in).InOutFunc:=@IOPipe;
  758. TextRec(Pipe_in).FlushFunc:=@FlushPipe;
  759. TextRec(Pipe_in).CloseFunc:=@ClosePipe;
  760. { Set up output }
  761. Assign(Pipe_out,'');
  762. Textrec(Pipe_out).Handle:=f_out;
  763. Textrec(Pipe_out).Mode:=fmOutput;
  764. Textrec(Pipe_out).userdata[1]:=P_OUT;
  765. TextRec(Pipe_out).OpenFunc:=@OpenPipe;
  766. TextRec(Pipe_out).InOutFunc:=@IOPipe;
  767. TextRec(Pipe_out).FlushFunc:=@FlushPipe;
  768. TextRec(Pipe_out).CloseFunc:=@ClosePipe;
  769. AssignPipe:=0;
  770. end;
  771. Function AssignPipe(var pipe_in,pipe_out:file):cint;
  772. {
  773. Sets up a pair of file variables, which act as a pipe. The first one can
  774. be read from, the second one can be written to.
  775. If the operation was unsuccesful,
  776. }
  777. var
  778. f_in,f_out : cint;
  779. begin
  780. if AssignPipe(f_in,f_out)=-1 then
  781. exit(-1);
  782. { Set up input }
  783. Assign(Pipe_in,'');
  784. Filerec(Pipe_in).Handle:=f_in;
  785. Filerec(Pipe_in).Mode:=fmInput;
  786. Filerec(Pipe_in).recsize:=1;
  787. Filerec(Pipe_in).userdata[1]:=P_IN;
  788. { Set up output }
  789. Assign(Pipe_out,'');
  790. Filerec(Pipe_out).Handle:=f_out;
  791. Filerec(Pipe_out).Mode:=fmoutput;
  792. Filerec(Pipe_out).recsize:=1;
  793. Filerec(Pipe_out).userdata[1]:=P_OUT;
  794. AssignPipe:=0;
  795. end;
  796. Function PCloseText(Var F:text):cint;
  797. {
  798. May not use @PClose due overloading
  799. }
  800. begin
  801. PCloseText:=PClose(f);
  802. end;
  803. function POpen(var F:text;const Prog:String;rw:char):cint;
  804. {
  805. Starts the program in 'Prog' and makes it's input or out put the
  806. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  807. F, will be read from stdin by the program in 'Prog'. The inverse is true
  808. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  809. read from 'f'.
  810. }
  811. var
  812. pipi,
  813. pipo : text;
  814. pid : pid_t;
  815. pl : ^cint;
  816. pp : ppchar;
  817. ret : cint;
  818. begin
  819. rw:=upcase(rw);
  820. if not (rw in ['R','W']) then
  821. begin
  822. FpSetErrno(ESysEnoent);
  823. exit(-1);
  824. end;
  825. if AssignPipe(pipi,pipo)=-1 Then
  826. Exit(-1);
  827. pid:=fpfork;
  828. if pid=-1 then
  829. begin
  830. close(pipi);
  831. close(pipo);
  832. exit(-1);
  833. end;
  834. if pid=0 then
  835. begin
  836. { We're in the child }
  837. if rw='W' then
  838. begin
  839. close(pipo);
  840. ret:=fpdup2(pipi,input);
  841. close(pipi);
  842. if ret=-1 then
  843. halt(127);
  844. end
  845. else
  846. begin
  847. close(pipi);
  848. ret:=fpdup2(pipo,output);
  849. close(pipo);
  850. if ret=-1 then
  851. halt(127);
  852. end;
  853. pp:=createshellargv(prog);
  854. fpExecve(pp^,pp,envp);
  855. halt(127);
  856. end
  857. else
  858. begin
  859. { We're in the parent }
  860. if rw='W' then
  861. begin
  862. close(pipi);
  863. f:=pipo;
  864. textrec(f).bufptr:=@textrec(f).buffer;
  865. end
  866. else
  867. begin
  868. close(pipo);
  869. f:=pipi;
  870. textrec(f).bufptr:=@textrec(f).buffer;
  871. end;
  872. {Save the process ID - needed when closing }
  873. pl:=@(textrec(f).userdata[2]);
  874. pl^:=pid;
  875. textrec(f).closefunc:=@PCloseText;
  876. end;
  877. ret:=0;
  878. end;
  879. Function POpen(var F:file;const Prog:String;rw:char):cint;
  880. {
  881. Starts the program in 'Prog' and makes it's input or out put the
  882. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  883. F, will be read from stdin by the program in 'Prog'. The inverse is true
  884. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  885. read from 'f'.
  886. }
  887. var
  888. pipi,
  889. pipo : file;
  890. pid : cint;
  891. pl : ^cint;
  892. p,pp : ppchar;
  893. temp : string[255];
  894. ret : cint;
  895. begin
  896. rw:=upcase(rw);
  897. if not (rw in ['R','W']) then
  898. begin
  899. FpSetErrno(ESysEnoent);
  900. exit(-1);
  901. end;
  902. ret:=AssignPipe(pipi,pipo);
  903. if ret=-1 then
  904. exit(-1);
  905. pid:=fpfork;
  906. if pid=-1 then
  907. begin
  908. close(pipi);
  909. close(pipo);
  910. exit(-1);
  911. end;
  912. if pid=0 then
  913. begin
  914. { We're in the child }
  915. if rw='W' then
  916. begin
  917. close(pipo);
  918. ret:=fpdup2(filerec(pipi).handle,stdinputhandle);
  919. close(pipi);
  920. if ret=-1 then
  921. halt(127);
  922. end
  923. else
  924. begin
  925. close(pipi);
  926. ret:=fpdup2(filerec(pipo).handle,stdoutputhandle);
  927. close(pipo);
  928. if ret=1 then
  929. halt(127);
  930. end;
  931. getmem(pp,sizeof(pchar)*4);
  932. temp:='/bin/sh'#0'-c'#0+prog+#0;
  933. p:=pp;
  934. p^:=@temp[1];
  935. inc(p);
  936. p^:=@temp[9];
  937. inc(p);
  938. p^:=@temp[12];
  939. inc(p);
  940. p^:=Nil;
  941. fpExecve(ansistring('/bin/sh'),pp,envp);
  942. halt(127);
  943. end
  944. else
  945. begin
  946. { We're in the parent }
  947. if rw='W' then
  948. begin
  949. close(pipi);
  950. f:=pipo;
  951. end
  952. else
  953. begin
  954. close(pipo);
  955. f:=pipi;
  956. end;
  957. {Save the process ID - needed when closing }
  958. pl:=@(filerec(f).userdata[2]);
  959. pl^:=pid;
  960. end;
  961. POpen:=0;
  962. end;
  963. Function AssignStream(Var StreamIn,Streamout:text;Const Prog:String) : cint;
  964. {
  965. Starts the program in 'Prog' and makes its input and output the
  966. other end of two pipes, which are the stdin and stdout of a program
  967. specified in 'Prog'.
  968. streamout can be used to write to the program, streamin can be used to read
  969. the output of the program. See the following diagram :
  970. Parent Child
  971. STreamout --> Input
  972. Streamin <-- Output
  973. Return value is the process ID of the process being spawned, or -1 in case of failure.
  974. }
  975. var
  976. pipi,
  977. pipo : text;
  978. pid : cint;
  979. pl : ^cint;
  980. begin
  981. AssignStream:=-1;
  982. if AssignPipe(streamin,pipo)=-1 Then
  983. exit(-1);
  984. if AssignPipe(pipi,streamout)=-1 Then // shouldn't this close streamin and pipo?
  985. exit(-1);
  986. pid:=fpfork;
  987. if pid=-1 then
  988. begin
  989. close(pipi);
  990. close(pipo);
  991. close (streamin);
  992. close (streamout);
  993. exit;
  994. end;
  995. if pid=0 then
  996. begin
  997. { We're in the child }
  998. { Close what we don't need }
  999. close(streamout);
  1000. close(streamin);
  1001. if fpdup2(pipi,input)=-1 Then
  1002. halt(127);
  1003. close(pipi);
  1004. If fpdup2(pipo,output)=-1 Then
  1005. halt (127);
  1006. close(pipo);
  1007. Execl(Prog);
  1008. halt(127);
  1009. end
  1010. else
  1011. begin
  1012. { we're in the parent}
  1013. close(pipo);
  1014. close(pipi);
  1015. {Save the process ID - needed when closing }
  1016. pl:=@(textrec(StreamIn).userdata[2]);
  1017. pl^:=pid;
  1018. textrec(StreamIn).closefunc:=@PCloseText;
  1019. {Save the process ID - needed when closing }
  1020. pl:=@(textrec(StreamOut).userdata[2]);
  1021. pl^:=pid;
  1022. textrec(StreamOut).closefunc:=@PCloseText;
  1023. AssignStream:=Pid;
  1024. end;
  1025. end;
  1026. function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String):cint;
  1027. {
  1028. Starts the program in 'prog' and makes its input, output and error output the
  1029. other end of three pipes, which are the stdin, stdout and stderr of a program
  1030. specified in 'prog'.
  1031. StreamOut can be used to write to the program, StreamIn can be used to read
  1032. the output of the program, StreamErr reads the error output of the program.
  1033. See the following diagram :
  1034. Parent Child
  1035. StreamOut --> StdIn (input)
  1036. StreamIn <-- StdOut (output)
  1037. StreamErr <-- StdErr (error output)
  1038. }
  1039. var
  1040. PipeIn, PipeOut, PipeErr: text;
  1041. pid: cint;
  1042. pl: ^cint;
  1043. begin
  1044. AssignStream := -1;
  1045. // Assign pipes
  1046. if AssignPipe(StreamIn, PipeOut)=-1 Then
  1047. Exit(-1);
  1048. If AssignPipe(StreamErr, PipeErr)=-1 Then
  1049. begin
  1050. Close(StreamIn);
  1051. Close(PipeOut);
  1052. exit(-1);
  1053. end;
  1054. if AssignPipe(PipeIn, StreamOut)=-1 Then
  1055. begin
  1056. Close(StreamIn);
  1057. Close(PipeOut);
  1058. Close(StreamErr);
  1059. Close(PipeErr);
  1060. exit(-1);
  1061. end;
  1062. // Fork
  1063. pid := fpFork;
  1064. if pid=-1 then begin
  1065. Close(StreamIn);
  1066. Close(PipeOut);
  1067. Close(StreamErr);
  1068. Close(PipeErr);
  1069. Close(PipeIn);
  1070. Close(StreamOut);
  1071. exit(-1);
  1072. end;
  1073. if pid = 0 then begin
  1074. // *** We are in the child ***
  1075. // Close what we don not need
  1076. Close(StreamOut);
  1077. Close(StreamIn);
  1078. Close(StreamErr);
  1079. // Connect pipes
  1080. if fpdup2(PipeIn, Input)=-1 Then
  1081. Halt(127);
  1082. Close(PipeIn);
  1083. if fpdup2(PipeOut, Output)=-1 Then
  1084. Halt(127);
  1085. Close(PipeOut);
  1086. if fpdup2(PipeErr, StdErr)=-1 Then
  1087. Halt(127);
  1088. Close(PipeErr);
  1089. // Execute program
  1090. Execl(Prog);
  1091. Halt(127);
  1092. end else begin
  1093. // *** We are in the parent ***
  1094. Close(PipeErr);
  1095. Close(PipeOut);
  1096. Close(PipeIn);
  1097. // Save the process ID - needed when closing
  1098. pl := @(TextRec(StreamIn).userdata[2]);
  1099. pl^ := pid;
  1100. TextRec(StreamIn).closefunc := @PCloseText;
  1101. // Save the process ID - needed when closing
  1102. pl := @(TextRec(StreamOut).userdata[2]);
  1103. pl^ := pid;
  1104. TextRec(StreamOut).closefunc := @PCloseText;
  1105. // Save the process ID - needed when closing
  1106. pl := @(TextRec(StreamErr).userdata[2]);
  1107. pl^ := pid;
  1108. TextRec(StreamErr).closefunc := @PCloseText;
  1109. AssignStream := pid;
  1110. end;
  1111. end;
  1112. {******************************************************************************
  1113. General information calls
  1114. ******************************************************************************}
  1115. {$ifndef BSD}
  1116. Function GetDomainName:String; { linux only!}
  1117. // domainname is a glibc extension.
  1118. {
  1119. Get machines domain name. Returns empty string if not set.
  1120. }
  1121. Var
  1122. Sysn : utsname;
  1123. begin
  1124. If fpUname(sysn)<>0 then
  1125. getdomainname:=''
  1126. else
  1127. getdomainname:=strpas(@Sysn.domain[0]);
  1128. end;
  1129. {$endif}
  1130. Function GetHostName:String;
  1131. {
  1132. Get machines name. Returns empty string if not set.
  1133. }
  1134. Var
  1135. Sysn : utsname;
  1136. begin
  1137. If fpuname(sysn)=-1 then
  1138. gethostname:=''
  1139. else
  1140. gethostname:=strpas(@Sysn.nodename[0]);
  1141. end;
  1142. {******************************************************************************
  1143. Signal handling calls
  1144. ******************************************************************************}
  1145. procedure SigRaise(sig:integer);
  1146. begin
  1147. fpKill(fpGetPid,Sig);
  1148. end;
  1149. {******************************************************************************
  1150. IOCtl and Termios calls
  1151. ******************************************************************************}
  1152. Function TCGetAttr(fd:cint;var tios:TermIOS):cint;
  1153. begin
  1154. {$ifndef BSD}
  1155. TCGetAttr:=fpIOCtl(fd,TCGETS,@tios);
  1156. {$else}
  1157. TCGETAttr:=fpIoCtl(Fd,TIOCGETA,@tios);
  1158. {$endif}
  1159. end;
  1160. Function TCSetAttr(fd:cint;OptAct:cint;const tios:TermIOS):cint;
  1161. var
  1162. nr:cint;
  1163. begin
  1164. {$ifndef BSD}
  1165. case OptAct of
  1166. TCSANOW : nr:=TCSETS;
  1167. TCSADRAIN : nr:=TCSETSW;
  1168. TCSAFLUSH : nr:=TCSETSF;
  1169. {$else}
  1170. case OptAct of
  1171. TCSANOW : nr:=TIOCSETA;
  1172. TCSADRAIN : nr:=TIOCSETAW;
  1173. TCSAFLUSH : nr:=TIOCSETAF;
  1174. {$endif}
  1175. else
  1176. begin
  1177. fpsetErrNo(ESysEINVAL);
  1178. TCSetAttr:=-1;
  1179. exit;
  1180. end;
  1181. end;
  1182. TCSetAttr:=fpIOCtl(fd,nr,@Tios);
  1183. end;
  1184. Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
  1185. begin
  1186. {$ifndef BSD}
  1187. tios.c_cflag:=(tios.c_cflag and (not CBAUD)) or speed;
  1188. {$else}
  1189. tios.c_ispeed:=speed; {Probably the Bxxxx speed constants}
  1190. {$endif}
  1191. end;
  1192. Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
  1193. begin
  1194. {$ifndef BSD}
  1195. CFSetISpeed(tios,speed);
  1196. {$else}
  1197. tios.c_ospeed:=speed;
  1198. {$endif}
  1199. end;
  1200. Procedure CFMakeRaw(var tios:TermIOS);
  1201. begin
  1202. {$ifndef BSD}
  1203. with tios do
  1204. begin
  1205. c_iflag:=c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
  1206. INLCR or IGNCR or ICRNL or IXON));
  1207. c_oflag:=c_oflag and (not OPOST);
  1208. c_lflag:=c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
  1209. c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or CS8;
  1210. end;
  1211. {$else}
  1212. with tios do
  1213. begin
  1214. c_iflag:=c_iflag and (not (IMAXBEL or IXOFF or INPCK or BRKINT or
  1215. PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON or
  1216. IGNPAR));
  1217. c_iflag:=c_iflag OR IGNBRK;
  1218. c_oflag:=c_oflag and (not OPOST);
  1219. c_lflag:=c_lflag and (not (ECHO or ECHOE or ECHOK or ECHONL or ICANON or
  1220. ISIG or IEXTEN or NOFLSH or TOSTOP or PENDIN));
  1221. c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or (CS8 OR cread);
  1222. c_cc[VMIN]:=1;
  1223. c_cc[VTIME]:=0;
  1224. end;
  1225. {$endif}
  1226. end;
  1227. Function TCSendBreak(fd,duration:cint):cint;
  1228. begin
  1229. {$ifndef BSD}
  1230. TCSendBreak:=fpIOCtl(fd,TCSBRK,pointer(duration));
  1231. {$else}
  1232. TCSendBreak:=fpIOCtl(fd,TIOCSBRK,0);
  1233. {$endif}
  1234. end;
  1235. Function TCSetPGrp(fd,id:cint):cint;
  1236. begin
  1237. TCSetPGrp:=fpIOCtl(fd,TIOCSPGRP,pointer(id));
  1238. end;
  1239. Function TCGetPGrp(fd:cint;var id:cint):cint;
  1240. begin
  1241. TCGetPGrp:=fpIOCtl(fd,TIOCGPGRP,@id);
  1242. end;
  1243. Function TCDrain(fd:cint):cint;
  1244. begin
  1245. {$ifndef BSD}
  1246. TCDrain:=fpIOCtl(fd,TCSBRK,pointer(1));
  1247. {$else}
  1248. TCDrain:=fpIOCtl(fd,TIOCDRAIN,0); {Should set timeout to 1 first?}
  1249. {$endif}
  1250. end;
  1251. Function TCFlow(fd,act:cint):cint;
  1252. begin
  1253. {$ifndef BSD}
  1254. TCFlow:=fpIOCtl(fd,TCXONC,pointer(act));
  1255. {$else}
  1256. case act OF
  1257. TCOOFF : TCFlow:=fpIoctl(fd,TIOCSTOP,0);
  1258. TCOOn : TCFlow:=fpIOctl(Fd,TIOCStart,0);
  1259. TCIOFF : {N/I}
  1260. end;
  1261. {$endif}
  1262. end;
  1263. Function TCFlush(fd,qsel:cint):cint;
  1264. begin
  1265. {$ifndef BSD}
  1266. TCFlush:=fpIOCtl(fd,TCFLSH,pointer(qsel));
  1267. {$else}
  1268. TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(qsel));
  1269. {$endif}
  1270. end;
  1271. Function IsATTY (Handle:cint):cint;
  1272. {
  1273. Check if the filehandle described by 'handle' is a TTY (Terminal)
  1274. }
  1275. var
  1276. t : Termios;
  1277. begin
  1278. IsAtty:=TCGetAttr(Handle,t);
  1279. end;
  1280. Function IsATTY(var f: text):cint;
  1281. {
  1282. Idem as previous, only now for text variables.
  1283. }
  1284. begin
  1285. IsATTY:=IsaTTY(textrec(f).handle);
  1286. end;
  1287. function TTYName(Handle:cint):string;
  1288. {
  1289. Return the name of the current tty described by handle f.
  1290. returns empty string in case of an error.
  1291. }
  1292. var
  1293. mydev : dev_t;
  1294. myino : ino_t;
  1295. st : stat;
  1296. function mysearch(n:string): boolean;
  1297. {searches recursively for the device in the directory given by n,
  1298. returns true if found and sets the name of the device in ttyname}
  1299. var dirstream : pdir;
  1300. d : pdirent;
  1301. name : string;
  1302. st : stat;
  1303. begin
  1304. dirstream:=fpopendir(n);
  1305. if (dirstream=nil) then
  1306. exit(false);
  1307. d:=fpReaddir(dirstream^);
  1308. while (d<>nil) do
  1309. begin
  1310. name:=n+'/'+strpas(@(d^.d_name));
  1311. // fpstat(name,st);
  1312. if fpstat(name,st)=0 then
  1313. begin
  1314. if (fpS_ISDIR(st.st_mode)) and { if it is a directory }
  1315. (strpas(@(d^.d_name))<>'.') and { but not ., .. and fd subdirs }
  1316. (strpas(@(d^.d_name))<>'..') and
  1317. (strpas(@(d^.d_name))<>'') and
  1318. (strpas(@(d^.d_name))<>'fd') then
  1319. begin {we found a directory, search inside it}
  1320. if mysearch(name) then
  1321. begin {the device is here}
  1322. fpclosedir(dirstream^); {then don't continue searching}
  1323. mysearch:=true;
  1324. exit;
  1325. end;
  1326. end
  1327. else if (ino_t(d^.d_fileno)=myino) and (st.st_dev=mydev) then
  1328. begin
  1329. fpclosedir(dirstream^);
  1330. ttyname:=name;
  1331. mysearch:=true;
  1332. exit;
  1333. end;
  1334. end;
  1335. d:=fpReaddir(dirstream^);
  1336. end;
  1337. fpclosedir(dirstream^);
  1338. mysearch:=false;
  1339. end;
  1340. begin
  1341. TTYName:='';
  1342. if (fpfstat(handle,st)=-1) and (isatty (handle)<>-1) then
  1343. exit;
  1344. mydev:=st.st_dev;
  1345. myino:=st.st_ino;
  1346. mysearch('/dev');
  1347. end;
  1348. function TTYName(var F:Text):string;
  1349. {
  1350. Idem as previous, only now for text variables;
  1351. }
  1352. begin
  1353. TTYName:=TTYName(textrec(f).handle);
  1354. end;
  1355. {******************************************************************************
  1356. Utility calls
  1357. ******************************************************************************}
  1358. {
  1359. Function Octal(l:cint):cint;
  1360. {
  1361. Convert an octal specified number to decimal;
  1362. }
  1363. var
  1364. octnr,
  1365. oct : cint;
  1366. begin
  1367. octnr:=0;
  1368. oct:=0;
  1369. while (l>0) do
  1370. begin
  1371. oct:=oct or ((l mod 10) shl octnr);
  1372. l:=l div 10;
  1373. inc(octnr,3);
  1374. end;
  1375. Octal:=oct;
  1376. end;
  1377. }
  1378. {$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
  1379. {$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
  1380. {$I fexpand.inc}
  1381. {$UNDEF FPC_FEXPAND_GETENVPCHAR}
  1382. {$UNDEF FPC_FEXPAND_TILDE}
  1383. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  1384. {
  1385. Searches for a file 'path' in the list of direcories in 'dirlist'.
  1386. returns an empty string if not found. Wildcards are NOT allowed.
  1387. If dirlist is empty, it is set to '.'
  1388. }
  1389. Var
  1390. NewDir : PathStr;
  1391. p1 : cint;
  1392. Info : Stat;
  1393. Begin
  1394. {Replace ':' with ';'}
  1395. for p1:=1to length(dirlist) do
  1396. if dirlist[p1]=':' then
  1397. dirlist[p1]:=';';
  1398. {Check for WildCards}
  1399. If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
  1400. FSearch:='' {No wildcards allowed in these things.}
  1401. Else
  1402. Begin
  1403. Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
  1404. Repeat
  1405. p1:=Pos(';',DirList);
  1406. If p1=0 Then
  1407. p1:=255;
  1408. NewDir:=Copy(DirList,1,P1 - 1);
  1409. if NewDir[Length(NewDir)]<>'/' then
  1410. NewDir:=NewDir+'/';
  1411. NewDir:=NewDir+Path;
  1412. Delete(DirList,1,p1);
  1413. if FpStat(NewDir,Info)>=0 then
  1414. Begin
  1415. If Pos('./',NewDir)=1 Then
  1416. Delete(NewDir,1,2);
  1417. {DOS strips off an initial .\}
  1418. End
  1419. Else
  1420. NewDir:='';
  1421. Until (DirList='') or (Length(NewDir) > 0);
  1422. FSearch:=NewDir;
  1423. End;
  1424. End;
  1425. Procedure Globfree(var p : pglob);
  1426. {
  1427. Release memory occupied by pglob structure, and names in it.
  1428. sets p to nil.
  1429. }
  1430. var
  1431. temp : pglob;
  1432. begin
  1433. while assigned(p) do
  1434. begin
  1435. temp:=p^.next;
  1436. if assigned(p^.name) then
  1437. freemem(p^.name);
  1438. dispose(p);
  1439. p:=temp;
  1440. end;
  1441. end;
  1442. Function Glob(Const path:pathstr):pglob;
  1443. {
  1444. Fills a tglob structure with entries matching path,
  1445. and returns a pointer to it. Returns nil on error,
  1446. linuxerror is set accordingly.
  1447. }
  1448. var
  1449. temp,
  1450. temp2 : string[255];
  1451. thedir : pdir;
  1452. buffer : pdirent;
  1453. root,
  1454. current : pglob;
  1455. begin
  1456. { Get directory }
  1457. temp:=dirname(path);
  1458. if temp='' then
  1459. temp:='.';
  1460. temp:=temp+#0;
  1461. thedir:=fpopendir(@temp[1]);
  1462. if thedir=nil then
  1463. exit(nil);
  1464. temp:=basename(path,''); { get the pattern }
  1465. if thedir^.dd_fd<0 then
  1466. exit(nil);
  1467. {get the entries}
  1468. root:=nil;
  1469. current:=nil;
  1470. repeat
  1471. buffer:=fpreaddir(thedir^);
  1472. if buffer=nil then
  1473. break;
  1474. temp2:=strpas(@(buffer^.d_name[0]));
  1475. if fnmatch(temp,temp2) then
  1476. begin
  1477. if root=nil then
  1478. begin
  1479. new(root);
  1480. current:=root;
  1481. end
  1482. else
  1483. begin
  1484. new(current^.next);
  1485. current:=current^.next;
  1486. end;
  1487. if current=nil then
  1488. begin
  1489. fpseterrno(ESysENOMEM);
  1490. globfree(root);
  1491. break;
  1492. end;
  1493. current^.next:=nil;
  1494. getmem(current^.name,length(temp2)+1);
  1495. if current^.name=nil then
  1496. begin
  1497. fpseterrno(ESysENOMEM);
  1498. globfree(root);
  1499. break;
  1500. end;
  1501. move(buffer^.d_name[0],current^.name^,length(temp2)+1);
  1502. end;
  1503. until false;
  1504. fpclosedir(thedir^);
  1505. glob:=root;
  1506. end;
  1507. Function GetFS (var T:Text):cint;
  1508. {
  1509. Get File Descriptor of a text file.
  1510. }
  1511. begin
  1512. if textrec(t).mode=fmclosed then
  1513. exit(-1)
  1514. else
  1515. GETFS:=textrec(t).Handle
  1516. end;
  1517. Function GetFS(Var F:File):cint;
  1518. {
  1519. Get File Descriptor of an unTyped file.
  1520. }
  1521. begin
  1522. { Handle and mode are on the same place in textrec and filerec. }
  1523. if filerec(f).mode=fmclosed then
  1524. exit(-1)
  1525. else
  1526. GETFS:=filerec(f).Handle
  1527. end;
  1528. {--------------------------------
  1529. Stat.Mode Macro's
  1530. --------------------------------}
  1531. Initialization
  1532. InitLocalTime;
  1533. finalization
  1534. DoneLocalTime;
  1535. End.
  1536. {
  1537. $Log$
  1538. Revision 1.48 2003-11-17 10:05:51 marco
  1539. * threads for FreeBSD. Not working tho
  1540. Revision 1.47 2003/11/14 17:30:14 marco
  1541. * weeehoo linuxerror is no more :-)
  1542. Revision 1.46 2003/11/14 16:44:48 marco
  1543. * stream functions converted to work without linuxerror
  1544. Revision 1.45 2003/11/13 18:44:06 marco
  1545. * small fi
  1546. Revision 1.44 2003/11/12 22:19:45 marco
  1547. * more linuxeror fixes
  1548. Revision 1.43 2003/11/03 09:42:28 marco
  1549. * Peter's Cardinal<->Longint fixes patch
  1550. Revision 1.42 2003/10/30 16:42:58 marco
  1551. * fixes for old syscall() convention removing
  1552. Revision 1.41 2003/10/12 19:40:43 marco
  1553. * ioctl fixes. IDE now starts, but
  1554. Revision 1.40 2003/09/29 14:36:06 peter
  1555. * fixed for stricter compiler
  1556. Revision 1.39 2003/09/27 12:51:33 peter
  1557. * fpISxxx macros renamed to C compliant fpS_ISxxx
  1558. Revision 1.38 2003/09/20 12:38:29 marco
  1559. * FCL now compiles for FreeBSD with new 1.1. Now Linux.
  1560. Revision 1.37 2003/09/17 19:07:44 marco
  1561. * more fixes for Unix<->unixutil
  1562. Revision 1.36 2003/09/17 17:30:46 marco
  1563. * Introduction of unixutil
  1564. Revision 1.35 2003/09/16 21:46:27 marco
  1565. * small fixes, checking things on linux
  1566. Revision 1.34 2003/09/16 20:52:24 marco
  1567. * small cleanups. Mostly killing of already commented code in unix etc
  1568. Revision 1.33 2003/09/16 16:13:56 marco
  1569. * fdset functions renamed to fp<posix name>
  1570. Revision 1.32 2003/09/15 20:08:49 marco
  1571. * small fixes. FreeBSD now cycles
  1572. Revision 1.31 2003/09/14 20:15:01 marco
  1573. * Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
  1574. Revision 1.30 2003/07/08 21:23:24 peter
  1575. * sparc fixes
  1576. Revision 1.29 2003/05/30 19:58:40 marco
  1577. * Getting NetBSD/i386 to compile.
  1578. Revision 1.28 2003/05/29 19:16:16 marco
  1579. * fixed a small *BSD gotcha
  1580. Revision 1.27 2003/05/24 20:39:54 jonas
  1581. * fixed ExitCode translation in WaitProcess for Linux and Darwin (and
  1582. probably other BSD's as well)
  1583. Revision 1.26 2003/03/11 08:27:59 michael
  1584. * stringtoppchar should use tabs instead of backspace as delimiter
  1585. Revision 1.25 2002/12/18 16:50:39 marco
  1586. * Unix RTL generic parts. Linux working, *BSD will follow shortly
  1587. Revision 1.24 2002/09/07 16:01:28 peter
  1588. * old logs removed and tabs fixed
  1589. Revision 1.23 2002/08/06 13:30:46 sg
  1590. * replaced some Longints with Cardinals, to mach the C headers
  1591. * updated the termios record
  1592. Revision 1.22 2002/03/05 20:04:25 michael
  1593. + Patch from Sebastian for FCNTL call
  1594. Revision 1.21 2002/01/02 12:22:54 marco
  1595. * Removed ifdef arround getepoch.
  1596. }