unix.pp 44 KB

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