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