unix.pp 42 KB

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