linux.pp 70 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065
  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 Linux;
  14. Interface
  15. { Get Types and Constants }
  16. {$i sysconst.inc}
  17. {$i systypes.inc}
  18. { Get System call numbers and error-numbers}
  19. {$i sysnr.inc}
  20. {$i errno.inc}
  21. {$I signal.inc}
  22. var
  23. ErrNo,
  24. LinuxError : Longint;
  25. {********************
  26. Process
  27. ********************}
  28. const
  29. { For getting/setting priority }
  30. Prio_Process = 0;
  31. Prio_PGrp = 1;
  32. Prio_User = 2;
  33. {$ifdef Solaris}
  34. WNOHANG = $100;
  35. WUNTRACED = $4;
  36. {$ELSE}
  37. WNOHANG = $1;
  38. WUNTRACED = $2;
  39. __WCLONE = $80000000;
  40. {$ENDIF}
  41. {********************
  42. File
  43. ********************}
  44. Const
  45. P_IN = 1;
  46. P_OUT = 2;
  47. Const
  48. LOCK_SH = 1;
  49. LOCK_EX = 2;
  50. LOCK_UN = 8;
  51. LOCK_NB = 4;
  52. Type
  53. Tpipe = array[1..2] of longint;
  54. pglob = ^tglob;
  55. tglob = record
  56. name : pchar;
  57. next : pglob;
  58. end;
  59. ComStr = String[255];
  60. PathStr = String[255];
  61. DirStr = String[255];
  62. NameStr = String[255];
  63. ExtStr = String[255];
  64. const
  65. { For testing access rights }
  66. R_OK = 4;
  67. W_OK = 2;
  68. X_OK = 1;
  69. F_OK = 0;
  70. { For File control mechanism }
  71. F_GetFd = 1;
  72. F_SetFd = 2;
  73. F_GetFl = 3;
  74. F_SetFl = 4;
  75. {$ifdef Solaris}
  76. F_DupFd = 0;
  77. F_Dup2Fd = 9;
  78. F_GetOwn = 23;
  79. F_SetOwn = 24;
  80. F_GetLk = 14;
  81. F_SetLk = 6;
  82. F_SetLkW = 7;
  83. F_FreeSp = 11;
  84. {$else}
  85. F_GetLk = 5;
  86. F_SetLk = 6;
  87. F_SetLkW = 7;
  88. F_SetOwn = 8;
  89. F_GetOwn = 9;
  90. {$endif}
  91. {********************
  92. IOCtl(TermIOS)
  93. ********************}
  94. {Is too freebsd/Linux specific}
  95. {$I termios.inc}
  96. {********************
  97. Info
  98. ********************}
  99. Type
  100. UTimBuf = packed record{in BSD array[0..1] of timeval, but this is
  101. backwards compatible with linux version}
  102. actime,
  103. {$ifdef BSD}
  104. uactime, {BSD Micro seconds}
  105. {$endif}
  106. modtime
  107. {$ifdef BSD}
  108. ,
  109. umodtime {BSD Micro seconds}
  110. {$endif}
  111. : longint;
  112. end;
  113. UTimeBuf=UTimBuf;
  114. TUTimeBuf=UTimeBuf;
  115. PUTimeBuf=^UTimeBuf;
  116. TSysinfo = packed record
  117. uptime : longint;
  118. loads : array[1..3] of longint;
  119. totalram,
  120. freeram,
  121. sharedram,
  122. bufferram,
  123. totalswap,
  124. freeswap : longint;
  125. procs : integer;
  126. s : string[18];
  127. end;
  128. PSysInfo = ^TSysInfo;
  129. {******************************************************************************
  130. Procedure/Functions
  131. ******************************************************************************}
  132. {$ifdef bsd}
  133. function Do_SysCall(sysnr:longint):longint;
  134. function Do_Syscall(sysnr,param1:integer):longint;
  135. function Do_SysCall(sysnr,param1:LONGINT):longint;
  136. function Do_SysCall(sysnr,param1,param2:LONGINT):longint;
  137. function Do_SysCall(sysnr,param1,param2,param3:LONGINT):longint;
  138. function Do_SysCall(sysnr,param1,param2,param3,param4:LONGINT):longint;
  139. function Do_SysCall(sysnr,param1,param2,param3,param4,param5:LONGINT):longint;
  140. function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:LONGINT):longint;
  141. function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:LONGINT):longint;
  142. {$else}
  143. Function SysCall(callnr:longint;var regs:SysCallregs):longint;
  144. {$endif}
  145. {**************************
  146. Time/Date Handling
  147. ***************************}
  148. var
  149. tzdaylight : boolean;
  150. tzseconds : longint;
  151. tzname : array[boolean] of pchar;
  152. { timezone support }
  153. procedure GetLocalTimezone(timer:longint;var leap_correct,leap_hit:longint);
  154. procedure GetLocalTimezone(timer:longint);
  155. procedure ReadTimezoneFile(fn:string);
  156. function GetTimezoneFile:string;
  157. Procedure GetTimeOfDay(var tv:timeval);
  158. Function GetTimeOfDay:longint;
  159. Function GetEpochTime: longint;
  160. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  161. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  162. procedure GetTime(var hour,min,sec,msec,usec:word);
  163. procedure GetTime(var hour,min,sec,sec100:word);
  164. procedure GetTime(var hour,min,sec:word);
  165. Procedure GetDate(Var Year,Month,Day:Word);
  166. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  167. function SetTime(Hour,Min,Sec:word) : Boolean;
  168. function SetDate(Year,Month,Day:Word) : Boolean;
  169. function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
  170. {**************************
  171. Process Handling
  172. ***************************}
  173. function CreateShellArgV(const prog:string):ppchar;
  174. function CreateShellArgV(const prog:Ansistring):ppchar;
  175. procedure FreeShellArgV(p:ppchar);
  176. Procedure Execve(Path: pathstr;args:ppchar;ep:ppchar);
  177. Procedure Execve(Path: AnsiString;args:ppchar;ep:ppchar);
  178. Procedure Execve(path: pchar;args:ppchar;ep:ppchar);
  179. Procedure Execv(const path:pathstr;args:ppchar);
  180. Procedure Execv(const path: AnsiString;args:ppchar);
  181. Procedure Execvp(Path: Pathstr;Args:ppchar;Ep:ppchar);
  182. Procedure Execvp(Path: AnsiString; Args:ppchar;Ep:ppchar);
  183. Procedure Execl(const Todo: String);
  184. Procedure Execl(const Todo: Ansistring);
  185. Procedure Execle(Todo: String;Ep:ppchar);
  186. Procedure Execle(Todo: AnsiString;Ep:ppchar);
  187. Procedure Execlp(Todo: string;Ep:ppchar);
  188. Procedure Execlp(Todo: Ansistring;Ep:ppchar);
  189. Function Shell(const Command:String):Longint;
  190. Function Shell(const Command:AnsiString):Longint;
  191. Function Fork:longint;
  192. {Clone for FreeBSD is copied from the LinuxThread port, and rfork based}
  193. function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
  194. Procedure ExitProcess(val:longint);
  195. Function WaitPid(Pid:longint;Status:pointer;Options:Longint):Longint; {=>PID (Status Valid), 0 (No Status), -1: Error, special case errno=EINTR }
  196. Function WaitProcess(Pid:longint):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
  197. Procedure Nice(N:integer);
  198. {$ifdef bsd}
  199. Function GetPriority(Which,Who:longint):longint;
  200. procedure SetPriority(Which,Who,What:longint);
  201. {$else}
  202. Function GetPriority(Which,Who:Integer):integer;
  203. Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
  204. {$endif}
  205. Function GetPid:LongInt;
  206. Function GetPPid:LongInt;
  207. Function GetUid:Longint;
  208. Function GetEUid:Longint;
  209. Function GetGid:Longint;
  210. Function GetEGid:Longint;
  211. {$ifdef solaris}
  212. // Set the real userid/groupid (uid/gid from calling process)
  213. Function SetUid(aUID:Longint):Boolean;
  214. Function SetGid(aGID:Longint):Boolean;
  215. // Set the real and effective userid/groupid (like setuid/setgid bit in file permissions)
  216. function SetreUid(aRealUID,aEffUid:Longint):Boolean; overload;
  217. function SetreUid(aUID:Longint):Boolean;overload;
  218. function SetreGid(aRealGid,aEffGid:Longint):Boolean; overload;
  219. function SetreGid(aGid:Longint):Boolean;overload;
  220. {$endif}
  221. {**************************
  222. File Handling
  223. ***************************}
  224. Function fdOpen(pathname:string;flags:longint):longint;
  225. Function fdOpen(pathname:string;flags,mode:longint):longint;
  226. Function fdOpen(pathname:pchar;flags:longint):longint;
  227. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  228. Function fdClose(fd:longint):boolean;
  229. Function fdRead(fd:longint;var buf;size:longint):longint;
  230. Function fdWrite(fd:longint;const buf;size:longint):longint;
  231. Function fdTruncate(fd,size:longint):boolean;
  232. Function fdSeek (fd,pos,seektype :longint): longint;
  233. Function fdFlush (fd : Longint) : Boolean;
  234. Function Link(OldPath,NewPath:pathstr):boolean;
  235. Function SymLink(OldPath,NewPath:pathstr):boolean;
  236. Function ReadLink(name,linkname:pchar;maxlen:longint):longint;
  237. Function ReadLink(name:pathstr):pathstr;
  238. Function UnLink(Path:pathstr):boolean;
  239. Function UnLink(Path:pchar):Boolean;
  240. Function FReName (OldName,NewName : Pchar) : Boolean;
  241. Function FReName (OldName,NewName : String) : Boolean;
  242. Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
  243. Function Chmod(path:pathstr;Newmode:longint):boolean;
  244. Function Utime(path:pathstr;utim:utimebuf):boolean;
  245. {$ifdef BSD}
  246. Function Access(Path:Pathstr ;mode:longint):boolean;
  247. {$else}
  248. Function Access(Path:Pathstr ;mode:integer):boolean;
  249. {$endif}
  250. Function Umask(Mask:Integer):integer;
  251. Function Flock (fd,mode : longint) : boolean;
  252. Function Flock (var T : text;mode : longint) : boolean;
  253. Function Flock (var F : File;mode : longint) : boolean;
  254. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  255. Function FStat(Fd:longint;Var Info:stat):Boolean;
  256. Function FStat(var F:Text;Var Info:stat):Boolean;
  257. Function FStat(var F:File;Var Info:stat):Boolean;
  258. Function Lstat(Filename: PathStr;var Info:stat):Boolean;
  259. Function StatFS(Path:Pathstr;Var Info:tstatfs):Boolean;
  260. Function StatFS(Fd: Longint;Var Info:tstatfs):Boolean;
  261. Function Fcntl(Fd:longint;Cmd:longint):longint;
  262. Procedure Fcntl(Fd:longint;Cmd:longint;Arg:Longint);
  263. Function Fcntl(var Fd:Text;Cmd:longint):longint;
  264. Procedure Fcntl(var Fd:Text;Cmd:longint;Arg:Longint);
  265. Function Dup(oldfile:longint;var newfile:longint):Boolean;
  266. Function Dup(var oldfile,newfile:text):Boolean;
  267. Function Dup(var oldfile,newfile:file):Boolean;
  268. Function Dup2(oldfile,newfile:longint):Boolean;
  269. Function Dup2(var oldfile,newfile:text):Boolean;
  270. Function Dup2(var oldfile,newfile:file):Boolean;
  271. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
  272. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  273. Function SelectText(var T:Text;TimeOut :PTimeVal):Longint;
  274. Function SelectText(var T:Text;TimeOut :Longint):Longint;
  275. {**************************
  276. Directory Handling
  277. ***************************}
  278. Function OpenDir(f:pchar):pdir;
  279. Function OpenDir(f: String):pdir;
  280. function CloseDir(p:pdir):integer;
  281. Function ReadDir(p:pdir):pdirent;
  282. procedure SeekDir(p:pdir;off:longint);
  283. function TellDir(p:pdir):longint;
  284. {**************************
  285. Pipe/Fifo/Stream
  286. ***************************}
  287. Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
  288. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  289. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  290. Function PClose(Var F:text) : longint;
  291. Function PClose(Var F:file) : longint;
  292. Procedure POpen(var F:text;const Prog:String;rw:char);
  293. Procedure POpen(var F:file;const Prog:String;rw:char);
  294. Function mkFifo(pathname:string;mode:longint):boolean;
  295. function AssignStream(Var StreamIn,Streamout:text;Const Prog:String) : longint;
  296. function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
  297. {**************************
  298. General information
  299. ***************************}
  300. Function GetEnv(P:string):Pchar;
  301. {$ifndef BSD}
  302. Function GetDomainName:String;
  303. Function GetHostName:String;
  304. Function Sysinfo(var Info:TSysinfo):Boolean;
  305. Function Uname(var unamerec:utsname):Boolean;
  306. {$endif}
  307. {**************************
  308. Signal
  309. ***************************}
  310. Procedure SigAction(Signum:longint;Act,OldAct:PSigActionRec );
  311. Procedure SigProcMask (How:longint;SSet,OldSSet:PSigSet);
  312. Function SigPending:SigSet;
  313. Procedure SigSuspend(Mask:Sigset);
  314. Function Signal(Signum:longint;Handler:SignalHandler):SignalHandler;
  315. Function Kill(Pid:longint;Sig:longint):integer;
  316. Procedure SigRaise(Sig:integer);
  317. {$ifndef BSD}
  318. Function Alarm(Sec : Longint) : longint;
  319. Procedure Pause;
  320. {$endif}
  321. Function NanoSleep(const req : timespec;var rem : timespec) : longint;
  322. {**************************
  323. IOCtl/Termios Functions
  324. ***************************}
  325. Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
  326. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  327. Function TCSetAttr(fd:longint;OptAct:longint;const tios:TermIOS):boolean;
  328. Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
  329. Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
  330. Procedure CFMakeRaw(var tios:TermIOS);
  331. Function TCSendBreak(fd,duration:longint):boolean;
  332. Function TCSetPGrp(fd,id:longint):boolean;
  333. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  334. Function TCFlush(fd,qsel:longint):boolean;
  335. Function TCDrain(fd:longint):boolean;
  336. Function TCFlow(fd,act:longint):boolean;
  337. Function IsATTY(Handle:Longint):Boolean;
  338. Function IsATTY(f:text):Boolean;
  339. function TTYname(Handle:Longint):string;
  340. function TTYname(var F:Text):string;
  341. {**************************
  342. Memory functions
  343. ***************************}
  344. (* the consts are System-dependend, not checked for solaris *)
  345. const
  346. PROT_READ = $1; { page can be read }
  347. PROT_WRITE = $2; { page can be written }
  348. PROT_EXEC = $4; { page can be executed }
  349. PROT_NONE = $0; { page can not be accessed }
  350. MAP_SHARED = $1; { Share changes }
  351. // MAP_PRIVATE = $2; { Changes are private }
  352. MAP_TYPE = $f; { Mask for type of mapping }
  353. MAP_FIXED = $10; { Interpret addr exactly }
  354. // MAP_ANONYMOUS = $20; { don't use a file }
  355. MAP_GROWSDOWN = $100; { stack-like segment }
  356. MAP_DENYWRITE = $800; { ETXTBSY }
  357. MAP_EXECUTABLE = $1000; { mark it as an executable }
  358. MAP_LOCKED = $2000; { pages are locked }
  359. MAP_NORESERVE = $4000; { don't check for reservations }
  360. type
  361. tmmapargs=record
  362. address : longint;
  363. size : longint;
  364. prot : longint;
  365. flags : longint;
  366. fd : longint;
  367. offset : longint;
  368. end;
  369. function MMap(const m:tmmapargs):longint;
  370. function MUnMap (P : Pointer; Size : Longint) : Boolean;
  371. {**************************
  372. Port IO functions
  373. ***************************}
  374. Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
  375. {$ifndef BSD}
  376. Function IoPL(Level : longint) : Boolean;
  377. {$endif}
  378. {$ifdef i386}
  379. Procedure WritePort (Port : Longint; Value : Byte);
  380. Procedure WritePort (Port : Longint; Value : Word);
  381. Procedure WritePort (Port : Longint; Value : Longint);
  382. Procedure WritePortB (Port : Longint; Value : Byte);
  383. Procedure WritePortW (Port : Longint; Value : Word);
  384. Procedure WritePortL (Port : Longint; Value : Longint);
  385. Procedure WritePortL (Port : Longint; Var Buf; Count: longint);
  386. Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
  387. Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
  388. Procedure ReadPort (Port : Longint; Var Value : Byte);
  389. Procedure ReadPort (Port : Longint; Var Value : Word);
  390. Procedure ReadPort (Port : Longint; Var Value : Longint);
  391. function ReadPortB (Port : Longint): Byte;
  392. function ReadPortW (Port : Longint): Word;
  393. function ReadPortL (Port : Longint): LongInt;
  394. Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
  395. Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
  396. Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
  397. {$endif}
  398. {**************************
  399. Utility functions
  400. ***************************}
  401. Function Octal(l:longint):longint;
  402. Function FExpand(Const Path: PathStr):PathStr;
  403. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  404. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  405. Function Dirname(Const path:pathstr):pathstr;
  406. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  407. Function FNMatch(const Pattern,Name:string):Boolean;
  408. Function Glob(Const path:pathstr):pglob;
  409. Procedure Globfree(var p:pglob);
  410. Function StringToPPChar(Var S:String):ppchar;
  411. Function StringToPPChar(Var S:AnsiString):ppchar;
  412. Function StringToPPChar(S : Pchar):ppchar;
  413. Function GetFS(var T:Text):longint;
  414. Function GetFS(Var F:File):longint;
  415. {Filedescriptorsets}
  416. Procedure FD_Zero(var fds:fdSet);
  417. Procedure FD_Clr(fd:longint;var fds:fdSet);
  418. Procedure FD_Set(fd:longint;var fds:fdSet);
  419. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  420. {Stat.Mode Types}
  421. Function S_ISLNK(m:word):boolean;
  422. Function S_ISREG(m:word):boolean;
  423. Function S_ISDIR(m:word):boolean;
  424. Function S_ISCHR(m:word):boolean;
  425. Function S_ISBLK(m:word):boolean;
  426. Function S_ISFIFO(m:word):boolean;
  427. Function S_ISSOCK(m:word):boolean;
  428. {******************************************************************************
  429. Implementation
  430. ******************************************************************************}
  431. Implementation
  432. Uses Strings,baseunix;
  433. { Get the definitions of textrec and filerec }
  434. {$i textrec.inc}
  435. {$i filerec.inc}
  436. { Raw System calls are in Syscalls.inc}
  437. {$i syscalls.inc}
  438. {$i unixsysc.inc} {Syscalls only used in unit Unix/Linux}
  439. {******************************************************************************
  440. Process related calls
  441. ******************************************************************************}
  442. { Most calls of WaitPID do not handle the result correctly, this funktion treats errors more correctly }
  443. Function WaitProcess(Pid:longint):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
  444. var r,s : LongInt;
  445. begin
  446. repeat
  447. s:=$7F00;
  448. r:=WaitPid(Pid,@s,0);
  449. until (r<>-1) or (LinuxError<>ESysEINTR);
  450. if (r=-1) or (r=0) then // 0 is not a valid return and should never occur (it means status invalid when using WNOHANG)
  451. WaitProcess:=-1 // return -1 to indicate an error
  452. else
  453. begin
  454. {$ifndef Solaris}
  455. WaitProcess:=s; // s<0 should not occur, but wie return also a negativ value
  456. {$else}
  457. if (s and $FF)=0 then // Only this is a valid returncode
  458. WaitProcess:=s shr 8
  459. else if (s>0) then // Until now there is not use of the highest bit , but check this for the future
  460. WaitProcess:=-s // normal case
  461. else
  462. WaitProcess:=s; // s<0 should not occur, but wie return also a negativ value
  463. {$endif}
  464. end;
  465. end;
  466. function InternalCreateShellArgV(cmd:pChar; len:longint):ppchar;
  467. {
  468. Create an argv which executes a command in a shell using /bin/sh -c
  469. }
  470. const Shell = '/bin/sh'#0'-c'#0;
  471. var
  472. pp,p : ppchar;
  473. // temp : string; !! Never pass a local var back!!
  474. begin
  475. getmem(pp,4*4);
  476. p:=pp;
  477. p^:=@Shell[1];
  478. inc(p);
  479. p^:=@Shell[9];
  480. inc(p);
  481. getmem(p^,len+1);
  482. move(cmd^,p^^,len);
  483. pchar(p^)[len]:=#0;
  484. inc(p);
  485. p^:=Nil;
  486. InternalCreateShellArgV:=pp;
  487. end;
  488. function CreateShellArgV(const prog:string):ppchar;
  489. begin
  490. CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog));
  491. end;
  492. function CreateShellArgV(const prog:Ansistring):ppchar;
  493. {
  494. Create an argv which executes a command in a shell using /bin/sh -c
  495. using a AnsiString;
  496. }
  497. begin
  498. CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog)); // if ppc works like delphi this also work when @prog[1] is invalid (len=0)
  499. end;
  500. procedure FreeShellArgV(p:ppchar);
  501. begin
  502. if (p<>nil) then begin
  503. freemem(p[2]);
  504. freemem(p);
  505. end;
  506. end;
  507. Procedure Execve(Path: AnsiString;args:ppchar;ep:ppchar);
  508. {
  509. overloaded ansistring version.
  510. }
  511. begin
  512. ExecVE(PChar(Path),args,ep);
  513. end;
  514. Procedure Execv(const path: AnsiString;args:ppchar);
  515. {
  516. Overloaded ansistring version.
  517. }
  518. begin
  519. ExecVe(Path,Args,envp)
  520. end;
  521. Procedure Execvp(Path: AnsiString; Args:ppchar;Ep:ppchar);
  522. {
  523. Overloaded ansistring version
  524. }
  525. var
  526. thepath : Ansistring;
  527. begin
  528. if path[1]<>'/' then
  529. begin
  530. Thepath:=strpas(getenv('PATH'));
  531. if thepath='' then
  532. thepath:='.';
  533. Path:=FSearch(path,thepath)
  534. end
  535. else
  536. Path:='';
  537. if Path='' then
  538. linuxerror:=ESysenoent
  539. else
  540. Execve(Path,args,ep);{On error linuxerror will get set there}
  541. end;
  542. Procedure Execv(const path:pathstr;args:ppchar);
  543. {
  544. Replaces the current program by the program specified in path,
  545. arguments in args are passed to Execve.
  546. the current environment is passed on.
  547. }
  548. begin
  549. Execve(path,args,envp); {On error linuxerror will get set there}
  550. end;
  551. Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
  552. {
  553. This does the same as Execve, only it searches the PATH environment
  554. for the place of the Executable, except when Path starts with a slash.
  555. if the PATH environment variable is unavailable, the path is set to '.'
  556. }
  557. var
  558. thepath : string;
  559. begin
  560. if path[1]<>'/' then
  561. begin
  562. Thepath:=strpas(getenv('PATH'));
  563. if thepath='' then
  564. thepath:='.';
  565. Path:=FSearch(path,thepath)
  566. end
  567. else
  568. Path:='';
  569. if Path='' then
  570. linuxerror:=ESysenoent
  571. else
  572. Execve(Path,args,ep);{On error linuxerror will get set there}
  573. end;
  574. Procedure Execle(Todo:string;Ep:ppchar);
  575. {
  576. This procedure takes the string 'Todo', parses it for command and
  577. command options, and Executes the command with the given options.
  578. The string 'Todo' shoud be of the form 'command options', options
  579. separated by commas.
  580. the PATH environment is not searched for 'command'.
  581. The specified environment(in 'ep') is passed on to command
  582. }
  583. var
  584. p : ppchar;
  585. begin
  586. p:=StringToPPChar(ToDo);
  587. if (p=nil) or (p^=nil) then
  588. exit;
  589. ExecVE(p^,p,EP);
  590. end;
  591. Procedure Execle(Todo:AnsiString;Ep:ppchar);
  592. {
  593. This procedure takes the string 'Todo', parses it for command and
  594. command options, and Executes the command with the given options.
  595. The string 'Todo' shoud be of the form 'command options', options
  596. separated by commas.
  597. the PATH environment is not searched for 'command'.
  598. The specified environment(in 'ep') is passed on to command
  599. }
  600. var
  601. p : ppchar;
  602. begin
  603. p:=StringToPPChar(ToDo);
  604. if (p=nil) or (p^=nil) then
  605. exit;
  606. ExecVE(p^,p,EP);
  607. end;
  608. Procedure Execl(const Todo:string);
  609. {
  610. This procedure takes the string 'Todo', parses it for command and
  611. command options, and Executes the command with the given options.
  612. The string 'Todo' shoud be of the form 'command options', options
  613. separated by commas.
  614. the PATH environment is not searched for 'command'.
  615. The current environment is passed on to command
  616. }
  617. begin
  618. ExecLE(ToDo,EnvP);
  619. end;
  620. Procedure Execlp(Todo:string;Ep:ppchar);
  621. {
  622. This procedure takes the string 'Todo', parses it for command and
  623. command options, and Executes the command with the given options.
  624. The string 'Todo' shoud be of the form 'command options', options
  625. separated by commas.
  626. the PATH environment is searched for 'command'.
  627. The specified environment (in 'ep') is passed on to command
  628. }
  629. var
  630. p : ppchar;
  631. begin
  632. p:=StringToPPchar(todo);
  633. if (p=nil) or (p^=nil) then
  634. exit;
  635. ExecVP(StrPas(p^),p,EP);
  636. end;
  637. Procedure Execlp(Todo: Ansistring;Ep:ppchar);
  638. {
  639. Overloaded ansistring version.
  640. }
  641. var
  642. p : ppchar;
  643. begin
  644. p:=StringToPPchar(todo);
  645. if (p=nil) or (p^=nil) then
  646. exit;
  647. ExecVP(StrPas(p^),p,EP);
  648. end;
  649. Function Shell(const Command:String):Longint;
  650. {
  651. Executes the shell, and passes it the string Command. (Through /bin/sh -c)
  652. The current environment is passed to the shell.
  653. It waits for the shell to exit, and returns its exit status.
  654. If the Exec call failed exit status 127 is reported.
  655. }
  656. { Changed the structure:
  657. - the previous version returns an undefinied value if fork fails
  658. - it returns the status of Waitpid instead of the Process returnvalue (see the doc to Shell)
  659. - it uses exit(127) not ExitProc (The Result in pp386: going on Compiling in 2 processes!)
  660. - ShellArgs are now released
  661. - The Old CreateShellArg gives back pointers to a local var
  662. }
  663. var
  664. p : ppchar;
  665. pid : longint;
  666. begin
  667. p:=CreateShellArgv(command);
  668. pid:=fork;
  669. if pid=0 then // We are in the Child
  670. begin
  671. {This is the child.}
  672. Execve(p^,p,envp);
  673. ExitProcess(127); // was Exit(127)
  674. end
  675. else if (pid<>-1) then // Successfull started
  676. Shell:=WaitProcess(pid) {Linuxerror is set there}
  677. else // no success
  678. Shell:=-1; // indicate an error
  679. FreeShellArgV(p);
  680. end;
  681. Function Shell(const Command:AnsiString):Longint;
  682. {
  683. AnsiString version of Shell
  684. }
  685. var
  686. p : ppchar;
  687. pid : longint;
  688. begin { Changes as above }
  689. p:=CreateShellArgv(command);
  690. pid:=fork;
  691. if pid=0 then // We are in the Child
  692. begin
  693. Execve(p^,p,envp);
  694. ExitProcess(127); // was exit(127)!! We must exit the Process, not the function
  695. end
  696. else if (pid<>-1) then // Successfull started
  697. Shell:=WaitProcess(pid) {Linuxerror is set there}
  698. else // no success
  699. Shell:=-1;
  700. FreeShellArgV(p);
  701. end;
  702. {******************************************************************************
  703. Date and Time related calls
  704. ******************************************************************************}
  705. Const
  706. {Date Translation}
  707. C1970=2440588;
  708. D0 = 1461;
  709. D1 = 146097;
  710. D2 =1721119;
  711. Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
  712. Var
  713. Century,XYear: LongInt;
  714. Begin
  715. If Month<=2 Then
  716. Begin
  717. Dec(Year);
  718. Inc(Month,12);
  719. End;
  720. Dec(Month,3);
  721. Century:=(longint(Year Div 100)*D1) shr 2;
  722. XYear:=(longint(Year Mod 100)*D0) shr 2;
  723. GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
  724. End;
  725. Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
  726. Var
  727. YYear,XYear,Temp,TempMonth : LongInt;
  728. Begin
  729. Temp:=((JulianDN-D2) shl 2)-1;
  730. JulianDN:=Temp Div D1;
  731. XYear:=(Temp Mod D1) or 3;
  732. YYear:=(XYear Div D0);
  733. Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
  734. Day:=((Temp Mod 153)+5) Div 5;
  735. TempMonth:=Temp Div 153;
  736. If TempMonth>=10 Then
  737. Begin
  738. inc(YYear);
  739. dec(TempMonth,12);
  740. End;
  741. inc(TempMonth,3);
  742. Month := TempMonth;
  743. Year:=YYear+(JulianDN*100);
  744. end;
  745. Function GetEpochTime: longint;
  746. {
  747. Get the number of seconds since 00:00, January 1 1970, GMT
  748. the time NOT corrected any way
  749. }
  750. begin
  751. GetEpochTime:=GetTimeOfDay;
  752. end;
  753. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  754. {
  755. Transforms Epoch time into local time (hour, minute,seconds)
  756. }
  757. Var
  758. DateNum: LongInt;
  759. Begin
  760. inc(Epoch,TZSeconds);
  761. Datenum:=(Epoch Div 86400) + c1970;
  762. JulianToGregorian(DateNum,Year,Month,day);
  763. Epoch:=Abs(Epoch Mod 86400);
  764. Hour:=Epoch Div 3600;
  765. Epoch:=Epoch Mod 3600;
  766. Minute:=Epoch Div 60;
  767. Second:=Epoch Mod 60;
  768. End;
  769. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  770. {
  771. Transforms local time (year,month,day,hour,minutes,second) to Epoch time
  772. (seconds since 00:00, january 1 1970, corrected for local time zone)
  773. }
  774. Begin
  775. LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
  776. (LongInt(Hour)*3600)+(Minute*60)+Second-TZSeconds;
  777. End;
  778. procedure GetTime(var hour,min,sec,msec,usec:word);
  779. {
  780. Gets the current time, adjusted to local time
  781. }
  782. var
  783. year,day,month:Word;
  784. t : timeval;
  785. begin
  786. gettimeofday(t);
  787. EpochToLocal(t.sec,year,month,day,hour,min,sec);
  788. msec:=t.usec div 1000;
  789. usec:=t.usec mod 1000;
  790. end;
  791. procedure GetTime(var hour,min,sec,sec100:word);
  792. {
  793. Gets the current time, adjusted to local time
  794. }
  795. var
  796. usec : word;
  797. begin
  798. gettime(hour,min,sec,sec100,usec);
  799. sec100:=sec100 div 10;
  800. end;
  801. Procedure GetTime(Var Hour,Min,Sec:Word);
  802. {
  803. Gets the current time, adjusted to local time
  804. }
  805. var
  806. msec,usec : Word;
  807. Begin
  808. gettime(hour,min,sec,msec,usec);
  809. End;
  810. Procedure GetDate(Var Year,Month,Day:Word);
  811. {
  812. Gets the current date, adjusted to local time
  813. }
  814. var
  815. hour,minute,second : word;
  816. Begin
  817. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  818. End;
  819. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  820. {
  821. Gets the current date, adjusted to local time
  822. }
  823. Begin
  824. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  825. End;
  826. {$ifndef BSD} {Start 1.0.x compiler FreeBSD cycle defines linux}
  827. {$ifdef Linux}
  828. Function stime (t : longint) : Boolean;
  829. var
  830. sr : Syscallregs;
  831. begin
  832. sr.reg2:=longint(@t);
  833. SysCall(Syscall_nr_stime,sr);
  834. linuxerror:=errno;
  835. stime:=linuxerror=0;
  836. end;
  837. {$endif}
  838. {$endif}
  839. {$ifdef BSD}
  840. Function stime (t : longint) : Boolean;
  841. begin
  842. end;
  843. {$endif}
  844. Function SetTime(Hour,Min,Sec:word) : boolean;
  845. var
  846. Year, Month, Day : Word;
  847. begin
  848. GetDate (Year, Month, Day);
  849. SetTime:=stime ( LocalToEpoch ( Year, Month, Day, Hour, Min, Sec ) );
  850. end;
  851. Function SetDate(Year,Month,Day:Word) : boolean;
  852. var
  853. Hour, Minute, Second, Sec100 : Word;
  854. begin
  855. GetTime ( Hour, Minute, Second, Sec100 );
  856. SetDate:=stime ( LocalToEpoch ( Year, Month, Day, Hour, Minute, Second ) );
  857. end;
  858. Function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
  859. begin
  860. SetDateTime:=stime ( LocalToEpoch ( Year, Month, Day, Hour, Minute, Second ) );
  861. end;
  862. Procedure Execl(const Todo:Ansistring);
  863. {
  864. Overloaded AnsiString Version of ExecL.
  865. }
  866. begin
  867. ExecLE(ToDo,EnvP);
  868. end;
  869. { Include timezone handling routines which use /usr/share/timezone info }
  870. {$i timezone.inc}
  871. {******************************************************************************
  872. FileSystem calls
  873. ******************************************************************************}
  874. Function fdOpen(pathname:string;flags:longint):longint;
  875. begin
  876. pathname:=pathname+#0;
  877. fdOpen:=Sys_Open(@pathname[1],flags,438);
  878. LinuxError:=Errno;
  879. end;
  880. Function fdOpen(pathname:string;flags,mode:longint):longint;
  881. begin
  882. pathname:=pathname+#0;
  883. fdOpen:=Sys_Open(@pathname[1],flags,mode);
  884. LinuxError:=Errno;
  885. end;
  886. Function fdOpen(pathname:pchar;flags:longint):longint;
  887. begin
  888. fdOpen:=Sys_Open(pathname,flags,0);
  889. LinuxError:=Errno;
  890. end;
  891. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  892. begin
  893. fdOpen:=Sys_Open(pathname,flags,mode);
  894. LinuxError:=Errno;
  895. end;
  896. Function fdClose(fd:longint):boolean;
  897. begin
  898. fdClose:=(Sys_Close(fd)=0);
  899. LinuxError:=Errno;
  900. end;
  901. Function fdRead(fd:longint;var buf;size:longint):longint;
  902. begin
  903. fdRead:=Sys_Read(fd,pchar(@buf),size);
  904. LinuxError:=Errno;
  905. end;
  906. Function fdWrite(fd:longint;const buf;size:longint):longint;
  907. begin
  908. fdWrite:=Sys_Write(fd,pchar(@buf),size);
  909. LinuxError:=Errno;
  910. end;
  911. Function fdSeek (fd,pos,seektype :longint): longint;
  912. {
  913. Do a Seek on a file descriptor fd to position pos, starting from seektype
  914. }
  915. begin
  916. fdseek:=Sys_LSeek (fd,pos,seektype);
  917. LinuxError:=Errno;
  918. end;
  919. {$ifdef BSD}
  920. Function Fcntl(Fd:longint;Cmd:longint):longint;
  921. {
  922. Read or manipulate a file.(See also fcntl (2) )
  923. Possible values for Cmd are :
  924. F_GetFd,F_GetFl,F_GetOwn
  925. Errors are reported in Linuxerror;
  926. If Cmd is different from the allowed values, linuxerror=ESyseninval.
  927. }
  928. begin
  929. if (cmd in [F_GetFd,F_GetFl,F_GetOwn]) then
  930. begin
  931. Linuxerror:=fpfcntl(fd,cmd,0);
  932. if linuxerror=-1 then
  933. begin
  934. linuxerror:=errno;
  935. fcntl:=0;
  936. end
  937. else
  938. begin
  939. fcntl:=linuxerror;
  940. linuxerror:=0;
  941. end;
  942. end
  943. else
  944. begin
  945. linuxerror:=ESyseinval;
  946. Fcntl:=0;
  947. end;
  948. end;
  949. Procedure Fcntl(Fd:longint;Cmd:longint;Arg:Longint);
  950. {
  951. Read or manipulate a file. (See also fcntl (2) )
  952. Possible values for Cmd are :
  953. F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
  954. Errors are reported in Linuxerror;
  955. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  956. F_DupFD is not allowed, due to the structure of Files in Pascal.
  957. }
  958. begin
  959. if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn]) then
  960. begin
  961. fpfcntl(fd,cmd,arg);
  962. LinuxError:=ErrNo;
  963. end
  964. else
  965. linuxerror:=ESyseinval;
  966. end;
  967. {$endif}
  968. Function Fcntl(var Fd:Text;Cmd:longint):longint;
  969. begin
  970. Fcntl := Fcntl(textrec(Fd).handle, Cmd);
  971. end;
  972. Procedure Fcntl(var Fd:Text;Cmd,Arg:Longint);
  973. begin
  974. Fcntl(textrec(Fd).handle, Cmd, Arg);
  975. end;
  976. Function Flock (var T : text;mode : longint) : boolean;
  977. begin
  978. Flock:=Flock(TextRec(T).Handle,mode);
  979. end;
  980. Function Flock (var F : File;mode : longint) : boolean;
  981. begin
  982. Flock:=Flock(FileRec(F).Handle,mode);
  983. end;
  984. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  985. {
  986. Get all information on a file, and return it in Info.
  987. }
  988. begin
  989. path:=path+#0;
  990. FStat:=(Sys_stat(@(path[1]),Info)=0);
  991. LinuxError:=errno;
  992. end;
  993. Function FStat(var F:Text;Var Info:stat):Boolean;
  994. {
  995. Get all information on a text file, and return it in info.
  996. }
  997. begin
  998. FStat:=Fstat(TextRec(F).Handle,INfo);
  999. end;
  1000. Function FStat(var F:File;Var Info:stat):Boolean;
  1001. {
  1002. Get all information on a untyped file, and return it in info.
  1003. }
  1004. begin
  1005. FStat:=Fstat(FileRec(F).Handle,Info);
  1006. end;
  1007. Function SymLink(OldPath,newPath:pathstr):boolean;
  1008. {
  1009. Proceduces a soft link from new to old.
  1010. }
  1011. begin
  1012. oldpath:=oldpath+#0;
  1013. newpath:=newpath+#0;
  1014. Symlink:=Sys_symlink(pchar(@(oldpath[1])),pchar(@(newpath[1])))=0;
  1015. linuxerror:=errno;
  1016. end;
  1017. Function ReadLink(name,linkname:pchar;maxlen:longint):longint;
  1018. {
  1019. Read a link (where it points to)
  1020. }
  1021. begin
  1022. Readlink:=Sys_readlink(Name,LinkName,maxlen);
  1023. linuxerror:=errno;
  1024. end;
  1025. Function ReadLink(Name:pathstr):pathstr;
  1026. {
  1027. Read a link (where it points to)
  1028. }
  1029. var
  1030. LinkName : pathstr;
  1031. i : longint;
  1032. begin
  1033. Name:=Name+#0;
  1034. i:=ReadLink(@Name[1],@LinkName[1],high(linkname));
  1035. if i>0 then
  1036. begin
  1037. linkname[0]:=chr(i);
  1038. ReadLink:=LinkName;
  1039. end
  1040. else
  1041. ReadLink:='';
  1042. end;
  1043. Function UnLink(Path:pathstr):boolean;
  1044. {
  1045. Removes the file in 'Path' (that is, it decreases the link count with one.
  1046. if the link count is zero, the file is removed from the disk.
  1047. }
  1048. begin
  1049. path:=path+#0;
  1050. Unlink:=Sys_unlink(pchar(@(path[1])))=0;
  1051. linuxerror:=errno;
  1052. end;
  1053. Function UnLink(Path:pchar):Boolean;
  1054. {
  1055. Removes the file in 'Path' (that is, it decreases the link count with one.
  1056. if the link count is zero, the file is removed from the disk.
  1057. }
  1058. begin
  1059. Unlink:=(Sys_unlink(path)=0);
  1060. linuxerror:=errno;
  1061. end;
  1062. Function FRename (OldName,NewName : Pchar) : Boolean;
  1063. begin
  1064. FRename:=Sys_rename(OldName,NewName)=0;
  1065. LinuxError:=Errno;
  1066. end;
  1067. Function FRename (OldName,NewName : String) : Boolean;
  1068. begin
  1069. OldName:=OldName+#0;
  1070. NewName:=NewName+#0;
  1071. FRename:=FRename (@OldName[1],@NewName[1]);
  1072. end;
  1073. Function Dup(var oldfile,newfile:text):Boolean;
  1074. {
  1075. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  1076. oldfile.
  1077. After which the two textfiles are, in effect, the same, except
  1078. that they don't share the same buffer, and don't share the same
  1079. close_on_exit flag.
  1080. }
  1081. begin
  1082. flush(oldfile);{ We cannot share buffers, so we flush them. }
  1083. textrec(newfile):=textrec(oldfile);
  1084. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  1085. Dup:=Dup(textrec(oldfile).handle,textrec(newfile).handle);
  1086. end;
  1087. Function Dup(var oldfile,newfile:file):Boolean;
  1088. {
  1089. Copies the filedescriptor oldfile to newfile
  1090. }
  1091. begin
  1092. filerec(newfile):=filerec(oldfile);
  1093. Dup:=Dup(filerec(oldfile).handle,filerec(newfile).handle);
  1094. end;
  1095. Function Dup2(var oldfile,newfile:text):Boolean;
  1096. {
  1097. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  1098. oldfile. It closes newfile if it was still open.
  1099. After which the two textfiles are, in effect, the same, except
  1100. that they don't share the same buffer, and don't share the same
  1101. close_on_exit flag.
  1102. }
  1103. var
  1104. tmphandle : word;
  1105. begin
  1106. case TextRec(oldfile).mode of
  1107. fmOutput, fmInOut, fmAppend :
  1108. flush(oldfile);{ We cannot share buffers, so we flush them. }
  1109. end;
  1110. case TextRec(newfile).mode of
  1111. fmOutput, fmInOut, fmAppend :
  1112. flush(newfile);
  1113. end;
  1114. tmphandle:=textrec(newfile).handle;
  1115. textrec(newfile):=textrec(oldfile);
  1116. textrec(newfile).handle:=tmphandle;
  1117. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  1118. Dup2:=Dup2(textrec(oldfile).handle,textrec(newfile).handle);
  1119. end;
  1120. Function Dup2(var oldfile,newfile:file):Boolean;
  1121. {
  1122. Copies the filedescriptor oldfile to newfile
  1123. }
  1124. begin
  1125. filerec(newfile):=filerec(oldfile);
  1126. Dup2:=Dup2(filerec(oldfile).handle,filerec(newfile).handle);
  1127. end;
  1128. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  1129. {
  1130. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  1131. have changed.
  1132. This function allows specification of a timeout as a longint.
  1133. }
  1134. var
  1135. p : PTimeVal;
  1136. tv : TimeVal;
  1137. begin
  1138. if TimeOut=-1 then
  1139. p:=nil
  1140. else
  1141. begin
  1142. tv.Sec:=Timeout div 1000;
  1143. tv.Usec:=(Timeout mod 1000)*1000;
  1144. p:=@tv;
  1145. end;
  1146. Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
  1147. end;
  1148. Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
  1149. Var
  1150. F:FDSet;
  1151. begin
  1152. if textrec(t).mode=fmclosed then
  1153. begin
  1154. LinuxError:=ESysEBadf;
  1155. exit(-1);
  1156. end;
  1157. FD_Zero(f);
  1158. FD_Set(textrec(T).handle,f);
  1159. if textrec(T).mode=fminput then
  1160. SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
  1161. else
  1162. SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
  1163. end;
  1164. Function SelectText(var T:Text;TimeOut :Longint):Longint;
  1165. var
  1166. p : PTimeVal;
  1167. tv : TimeVal;
  1168. begin
  1169. if TimeOut=-1 then
  1170. p:=nil
  1171. else
  1172. begin
  1173. tv.Sec:=Timeout div 1000;
  1174. tv.Usec:=(Timeout mod 1000)*1000;
  1175. p:=@tv;
  1176. end;
  1177. SelectText:=SelectText(T,p);
  1178. end;
  1179. {******************************************************************************
  1180. Directory
  1181. ******************************************************************************}
  1182. Function OpenDir(F:String):PDir;
  1183. begin
  1184. F:=F+#0;
  1185. OpenDir:=OpenDir(@F[1]);
  1186. LinuxError:=ErrNo;
  1187. end;
  1188. procedure SeekDir(p:pdir;off:longint);
  1189. begin
  1190. if p=nil then
  1191. begin
  1192. errno:=ESysEBadf;
  1193. exit;
  1194. end;
  1195. {$ifndef bsd} {Should be ifdef Linux, but can't because
  1196. of 1.0.5 cycle}
  1197. {$ifndef Solaris}
  1198. p^.nextoff:=Sys_lseek(p^.fd,off,seek_set);
  1199. {$endif}
  1200. {$endif}
  1201. p^.size:=0;
  1202. p^.loc:=0;
  1203. end;
  1204. function TellDir(p:pdir):longint;
  1205. begin
  1206. if p=nil then
  1207. begin
  1208. errno:=ESysEBadf;
  1209. telldir:=-1;
  1210. exit;
  1211. end;
  1212. telldir:=Sys_lseek(p^.fd,0,seek_cur)
  1213. { We could try to use the nextoff field here, but on my 1.2.13
  1214. kernel, this gives nothing... This may have to do with
  1215. the readdir implementation of libc... I also didn't find any trace of
  1216. the field in the kernel code itself, So I suspect it is an artifact of libc.
  1217. Michael. }
  1218. end;
  1219. Function ReadDir(P:pdir):pdirent;
  1220. begin
  1221. ReadDir:=Sys_ReadDir(p);
  1222. LinuxError:=Errno;
  1223. end;
  1224. {******************************************************************************
  1225. Pipes/Fifo
  1226. ******************************************************************************}
  1227. Procedure OpenPipe(var F:Text);
  1228. begin
  1229. case textrec(f).mode of
  1230. fmoutput :
  1231. if textrec(f).userdata[1]<>P_OUT then
  1232. textrec(f).mode:=fmclosed;
  1233. fminput :
  1234. if textrec(f).userdata[1]<>P_IN then
  1235. textrec(f).mode:=fmclosed;
  1236. else
  1237. textrec(f).mode:=fmclosed;
  1238. end;
  1239. end;
  1240. Procedure IOPipe(var F:text);
  1241. begin
  1242. case textrec(f).mode of
  1243. fmoutput :
  1244. begin
  1245. { first check if we need something to write, else we may
  1246. get a SigPipe when Close() is called (PFV) }
  1247. if textrec(f).bufpos>0 then
  1248. Sys_write(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
  1249. end;
  1250. fminput :
  1251. textrec(f).bufend:=Sys_read(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
  1252. end;
  1253. textrec(f).bufpos:=0;
  1254. end;
  1255. Procedure FlushPipe(var F:Text);
  1256. begin
  1257. if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
  1258. IOPipe(f);
  1259. textrec(f).bufpos:=0;
  1260. end;
  1261. Procedure ClosePipe(var F:text);
  1262. begin
  1263. textrec(f).mode:=fmclosed;
  1264. Sys_close(textrec(f).handle);
  1265. end;
  1266. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  1267. {
  1268. Sets up a pair of file variables, which act as a pipe. The first one can
  1269. be read from, the second one can be written to.
  1270. If the operation was unsuccesful, linuxerror is set.
  1271. }
  1272. var
  1273. f_in,f_out : longint;
  1274. begin
  1275. if not AssignPipe(f_in,f_out) then
  1276. begin
  1277. AssignPipe:=false;
  1278. exit;
  1279. end;
  1280. { Set up input }
  1281. Assign(Pipe_in,'');
  1282. Textrec(Pipe_in).Handle:=f_in;
  1283. Textrec(Pipe_in).Mode:=fmInput;
  1284. Textrec(Pipe_in).userdata[1]:=P_IN;
  1285. TextRec(Pipe_in).OpenFunc:=@OpenPipe;
  1286. TextRec(Pipe_in).InOutFunc:=@IOPipe;
  1287. TextRec(Pipe_in).FlushFunc:=@FlushPipe;
  1288. TextRec(Pipe_in).CloseFunc:=@ClosePipe;
  1289. { Set up output }
  1290. Assign(Pipe_out,'');
  1291. Textrec(Pipe_out).Handle:=f_out;
  1292. Textrec(Pipe_out).Mode:=fmOutput;
  1293. Textrec(Pipe_out).userdata[1]:=P_OUT;
  1294. TextRec(Pipe_out).OpenFunc:=@OpenPipe;
  1295. TextRec(Pipe_out).InOutFunc:=@IOPipe;
  1296. TextRec(Pipe_out).FlushFunc:=@FlushPipe;
  1297. TextRec(Pipe_out).CloseFunc:=@ClosePipe;
  1298. AssignPipe:=true;
  1299. end;
  1300. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  1301. {
  1302. Sets up a pair of file variables, which act as a pipe. The first one can
  1303. be read from, the second one can be written to.
  1304. If the operation was unsuccesful, linuxerror is set.
  1305. }
  1306. var
  1307. f_in,f_out : longint;
  1308. begin
  1309. if not AssignPipe(f_in,f_out) then
  1310. begin
  1311. AssignPipe:=false;
  1312. exit;
  1313. end;
  1314. { Set up input }
  1315. Assign(Pipe_in,'');
  1316. Filerec(Pipe_in).Handle:=f_in;
  1317. Filerec(Pipe_in).Mode:=fmInput;
  1318. Filerec(Pipe_in).recsize:=1;
  1319. Filerec(Pipe_in).userdata[1]:=P_IN;
  1320. { Set up output }
  1321. Assign(Pipe_out,'');
  1322. Filerec(Pipe_out).Handle:=f_out;
  1323. Filerec(Pipe_out).Mode:=fmoutput;
  1324. Filerec(Pipe_out).recsize:=1;
  1325. Filerec(Pipe_out).userdata[1]:=P_OUT;
  1326. AssignPipe:=true;
  1327. end;
  1328. Procedure PCloseText(Var F:text);
  1329. {
  1330. May not use @PClose due overloading
  1331. }
  1332. begin
  1333. PClose(f);
  1334. end;
  1335. Procedure POpen(var F:text;const Prog:String;rw:char);
  1336. {
  1337. Starts the program in 'Prog' and makes it's input or out put the
  1338. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  1339. F, will be read from stdin by the program in 'Prog'. The inverse is true
  1340. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  1341. read from 'f'.
  1342. }
  1343. var
  1344. pipi,
  1345. pipo : text;
  1346. pid : longint;
  1347. pl : ^longint;
  1348. pp : ppchar;
  1349. begin
  1350. LinuxError:=0;
  1351. rw:=upcase(rw);
  1352. if not (rw in ['R','W']) then
  1353. begin
  1354. LinuxError:=ESysENOENT;
  1355. exit;
  1356. end;
  1357. AssignPipe(pipi,pipo);
  1358. if Linuxerror<>0 then
  1359. exit;
  1360. pid:=fork;
  1361. if linuxerror<>0 then
  1362. begin
  1363. close(pipi);
  1364. close(pipo);
  1365. exit;
  1366. end;
  1367. if pid=0 then
  1368. begin
  1369. { We're in the child }
  1370. if rw='W' then
  1371. begin
  1372. close(pipo);
  1373. dup2(pipi,input);
  1374. close(pipi);
  1375. if linuxerror<>0 then
  1376. halt(127);
  1377. end
  1378. else
  1379. begin
  1380. close(pipi);
  1381. dup2(pipo,output);
  1382. close(pipo);
  1383. if linuxerror<>0 then
  1384. halt(127);
  1385. end;
  1386. pp:=createshellargv(prog);
  1387. Execve(pp^,pp,envp);
  1388. halt(127);
  1389. end
  1390. else
  1391. begin
  1392. { We're in the parent }
  1393. if rw='W' then
  1394. begin
  1395. close(pipi);
  1396. f:=pipo;
  1397. textrec(f).bufptr:=@textrec(f).buffer;
  1398. end
  1399. else
  1400. begin
  1401. close(pipo);
  1402. f:=pipi;
  1403. textrec(f).bufptr:=@textrec(f).buffer;
  1404. end;
  1405. {Save the process ID - needed when closing }
  1406. pl:=@(textrec(f).userdata[2]);
  1407. pl^:=pid;
  1408. textrec(f).closefunc:=@PCloseText;
  1409. end;
  1410. end;
  1411. Procedure POpen(var F:file;const Prog:String;rw:char);
  1412. {
  1413. Starts the program in 'Prog' and makes it's input or out put the
  1414. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  1415. F, will be read from stdin by the program in 'Prog'. The inverse is true
  1416. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  1417. read from 'f'.
  1418. }
  1419. var
  1420. pipi,
  1421. pipo : file;
  1422. pid : longint;
  1423. pl : ^longint;
  1424. p,pp : ppchar;
  1425. temp : string[255];
  1426. begin
  1427. LinuxError:=0;
  1428. rw:=upcase(rw);
  1429. if not (rw in ['R','W']) then
  1430. begin
  1431. LinuxError:=ESysENOENT;
  1432. exit;
  1433. end;
  1434. AssignPipe(pipi,pipo);
  1435. if Linuxerror<>0 then
  1436. exit;
  1437. pid:=fork;
  1438. if linuxerror<>0 then
  1439. begin
  1440. close(pipi);
  1441. close(pipo);
  1442. exit;
  1443. end;
  1444. if pid=0 then
  1445. begin
  1446. { We're in the child }
  1447. if rw='W' then
  1448. begin
  1449. close(pipo);
  1450. dup2(filerec(pipi).handle,stdinputhandle);
  1451. close(pipi);
  1452. if linuxerror<>0 then
  1453. halt(127);
  1454. end
  1455. else
  1456. begin
  1457. close(pipi);
  1458. dup2(filerec(pipo).handle,stdoutputhandle);
  1459. close(pipo);
  1460. if linuxerror<>0 then
  1461. halt(127);
  1462. end;
  1463. getmem(pp,sizeof(pchar)*4);
  1464. temp:='/bin/sh'#0'-c'#0+prog+#0;
  1465. p:=pp;
  1466. p^:=@temp[1];
  1467. inc(p);
  1468. p^:=@temp[9];
  1469. inc(p);
  1470. p^:=@temp[12];
  1471. inc(p);
  1472. p^:=Nil;
  1473. Execve('/bin/sh',pp,envp);
  1474. halt(127);
  1475. end
  1476. else
  1477. begin
  1478. { We're in the parent }
  1479. if rw='W' then
  1480. begin
  1481. close(pipi);
  1482. f:=pipo;
  1483. end
  1484. else
  1485. begin
  1486. close(pipo);
  1487. f:=pipi;
  1488. end;
  1489. {Save the process ID - needed when closing }
  1490. pl:=@(filerec(f).userdata[2]);
  1491. pl^:=pid;
  1492. end;
  1493. end;
  1494. Function AssignStream(Var StreamIn,Streamout:text;Const Prog:String) : longint;
  1495. {
  1496. Starts the program in 'Prog' and makes its input and output the
  1497. other end of two pipes, which are the stdin and stdout of a program
  1498. specified in 'Prog'.
  1499. streamout can be used to write to the program, streamin can be used to read
  1500. the output of the program. See the following diagram :
  1501. Parent Child
  1502. STreamout --> Input
  1503. Streamin <-- Output
  1504. Return value is the process ID of the process being spawned, or -1 in case of failure.
  1505. }
  1506. var
  1507. pipi,
  1508. pipo : text;
  1509. pid : longint;
  1510. pl : ^Longint;
  1511. begin
  1512. LinuxError:=0;
  1513. AssignStream:=-1;
  1514. AssignPipe(streamin,pipo);
  1515. if Linuxerror<>0 then
  1516. exit;
  1517. AssignPipe(pipi,streamout);
  1518. if Linuxerror<>0 then
  1519. exit;
  1520. pid:=fork;
  1521. if linuxerror<>0 then
  1522. begin
  1523. close(pipi);
  1524. close(pipo);
  1525. close (streamin);
  1526. close (streamout);
  1527. exit;
  1528. end;
  1529. if pid=0 then
  1530. begin
  1531. { We're in the child }
  1532. { Close what we don't need }
  1533. close(streamout);
  1534. close(streamin);
  1535. dup2(pipi,input);
  1536. if linuxerror<>0 then
  1537. halt(127);
  1538. close(pipi);
  1539. dup2(pipo,output);
  1540. if linuxerror<>0 then
  1541. halt (127);
  1542. close(pipo);
  1543. Execl(Prog);
  1544. halt(127);
  1545. end
  1546. else
  1547. begin
  1548. { we're in the parent}
  1549. close(pipo);
  1550. close(pipi);
  1551. {Save the process ID - needed when closing }
  1552. pl:=@(textrec(StreamIn).userdata[2]);
  1553. pl^:=pid;
  1554. textrec(StreamIn).closefunc:=@PCloseText;
  1555. {Save the process ID - needed when closing }
  1556. pl:=@(textrec(StreamOut).userdata[2]);
  1557. pl^:=pid;
  1558. textrec(StreamOut).closefunc:=@PCloseText;
  1559. AssignStream:=Pid;
  1560. end;
  1561. end;
  1562. function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
  1563. {
  1564. Starts the program in 'prog' and makes its input, output and error output the
  1565. other end of three pipes, which are the stdin, stdout and stderr of a program
  1566. specified in 'prog'.
  1567. StreamOut can be used to write to the program, StreamIn can be used to read
  1568. the output of the program, StreamErr reads the error output of the program.
  1569. See the following diagram :
  1570. Parent Child
  1571. StreamOut --> StdIn (input)
  1572. StreamIn <-- StdOut (output)
  1573. StreamErr <-- StdErr (error output)
  1574. }
  1575. var
  1576. PipeIn, PipeOut, PipeErr: text;
  1577. pid: LongInt;
  1578. pl: ^LongInt;
  1579. begin
  1580. LinuxError := 0;
  1581. AssignStream := -1;
  1582. // Assign pipes
  1583. AssignPipe(StreamIn, PipeOut);
  1584. if LinuxError <> 0 then exit;
  1585. AssignPipe(StreamErr, PipeErr);
  1586. if LinuxError <> 0 then begin
  1587. Close(StreamIn);
  1588. Close(PipeOut);
  1589. exit;
  1590. end;
  1591. AssignPipe(PipeIn, StreamOut);
  1592. if LinuxError <> 0 then begin
  1593. Close(StreamIn);
  1594. Close(PipeOut);
  1595. Close(StreamErr);
  1596. Close(PipeErr);
  1597. exit;
  1598. end;
  1599. // Fork
  1600. pid := Fork;
  1601. if LinuxError <> 0 then begin
  1602. Close(StreamIn);
  1603. Close(PipeOut);
  1604. Close(StreamErr);
  1605. Close(PipeErr);
  1606. Close(PipeIn);
  1607. Close(StreamOut);
  1608. exit;
  1609. end;
  1610. if pid = 0 then begin
  1611. // *** We are in the child ***
  1612. // Close what we don not need
  1613. Close(StreamOut);
  1614. Close(StreamIn);
  1615. Close(StreamErr);
  1616. // Connect pipes
  1617. dup2(PipeIn, Input);
  1618. if LinuxError <> 0 then Halt(127);
  1619. Close(PipeIn);
  1620. dup2(PipeOut, Output);
  1621. if LinuxError <> 0 then Halt(127);
  1622. Close(PipeOut);
  1623. dup2(PipeErr, StdErr);
  1624. if LinuxError <> 0 then Halt(127);
  1625. Close(PipeErr);
  1626. // Execute program
  1627. Execl(Prog);
  1628. Halt(127);
  1629. end else begin
  1630. // *** We are in the parent ***
  1631. Close(PipeErr);
  1632. Close(PipeOut);
  1633. Close(PipeIn);
  1634. // Save the process ID - needed when closing
  1635. pl := @(TextRec(StreamIn).userdata[2]);
  1636. pl^ := pid;
  1637. TextRec(StreamIn).closefunc := @PCloseText;
  1638. // Save the process ID - needed when closing
  1639. pl := @(TextRec(StreamOut).userdata[2]);
  1640. pl^ := pid;
  1641. TextRec(StreamOut).closefunc := @PCloseText;
  1642. // Save the process ID - needed when closing
  1643. pl := @(TextRec(StreamErr).userdata[2]);
  1644. pl^ := pid;
  1645. TextRec(StreamErr).closefunc := @PCloseText;
  1646. AssignStream := pid;
  1647. end;
  1648. end;
  1649. {******************************************************************************
  1650. General information calls
  1651. ******************************************************************************}
  1652. Function GetEnv(P:string):Pchar;
  1653. {
  1654. Searches the environment for a string with name p and
  1655. returns a pchar to it's value.
  1656. A pchar is used to accomodate for strings of length > 255
  1657. }
  1658. var
  1659. ep : ppchar;
  1660. found : boolean;
  1661. Begin
  1662. p:=p+'='; {Else HOST will also find HOSTNAME, etc}
  1663. ep:=envp;
  1664. found:=false;
  1665. if ep<>nil then
  1666. begin
  1667. while (not found) and (ep^<>nil) do
  1668. begin
  1669. if strlcomp(@p[1],(ep^),length(p))=0 then
  1670. found:=true
  1671. else
  1672. inc(ep);
  1673. end;
  1674. end;
  1675. if found then
  1676. getenv:=ep^+length(p)
  1677. else
  1678. getenv:=nil;
  1679. end;
  1680. {$ifndef bsd}
  1681. Function GetDomainName:String;
  1682. {
  1683. Get machines domain name. Returns empty string if not set.
  1684. }
  1685. Var
  1686. Sysn : utsname;
  1687. begin
  1688. Uname(Sysn);
  1689. linuxerror:=errno;
  1690. If linuxerror<>0 then
  1691. getdomainname:=''
  1692. else
  1693. getdomainname:=strpas(@Sysn.domainname[0]);
  1694. end;
  1695. Function GetHostName:String;
  1696. {
  1697. Get machines name. Returns empty string if not set.
  1698. }
  1699. Var
  1700. Sysn : utsname;
  1701. begin
  1702. uname(Sysn);
  1703. linuxerror:=errno;
  1704. If linuxerror<>0 then
  1705. gethostname:=''
  1706. else
  1707. gethostname:=strpas(@Sysn.nodename[0]);
  1708. end;
  1709. {$endif}
  1710. {******************************************************************************
  1711. Signal handling calls
  1712. ******************************************************************************}
  1713. procedure SigRaise(sig:integer);
  1714. begin
  1715. Kill(GetPid,Sig);
  1716. end;
  1717. {******************************************************************************
  1718. IOCtl and Termios calls
  1719. ******************************************************************************}
  1720. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  1721. begin
  1722. {$ifndef BSD}
  1723. TCGetAttr:=IOCtl(fd,TCGETS,@tios);
  1724. {$else}
  1725. TCGETAttr:=IoCtl(Fd,TIOCGETA,@tios);
  1726. {$endif}
  1727. end;
  1728. Function TCSetAttr(fd:longint;OptAct:longint;const tios:TermIOS):boolean;
  1729. var
  1730. nr:longint;
  1731. begin
  1732. {$ifndef BSD}
  1733. case OptAct of
  1734. TCSANOW : nr:=TCSETS;
  1735. TCSADRAIN : nr:=TCSETSW;
  1736. TCSAFLUSH : nr:=TCSETSF;
  1737. {$else}
  1738. case OptAct of
  1739. TCSANOW : nr:=TIOCSETA;
  1740. TCSADRAIN : nr:=TIOCSETAW;
  1741. TCSAFLUSH : nr:=TIOCSETAF;
  1742. {$endif}
  1743. else
  1744. begin
  1745. ErrNo:=ESysEINVAL;
  1746. TCSetAttr:=false;
  1747. exit;
  1748. end;
  1749. end;
  1750. TCSetAttr:=IOCtl(fd,nr,@Tios);
  1751. end;
  1752. Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
  1753. begin
  1754. {$ifndef BSD}
  1755. tios.c_cflag:=(tios.c_cflag and (not CBAUD)) or speed;
  1756. {$else}
  1757. tios.c_ispeed:=speed; {Probably the Bxxxx speed constants}
  1758. {$endif}
  1759. end;
  1760. Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
  1761. begin
  1762. {$ifndef BSD}
  1763. CFSetISpeed(tios,speed);
  1764. {$else}
  1765. tios.c_ospeed:=speed;
  1766. {$endif}
  1767. end;
  1768. Procedure CFMakeRaw(var tios:TermIOS);
  1769. begin
  1770. {$ifndef BSD}
  1771. with tios do
  1772. begin
  1773. c_iflag:=c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
  1774. INLCR or IGNCR or ICRNL or IXON));
  1775. c_oflag:=c_oflag and (not OPOST);
  1776. c_lflag:=c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
  1777. c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or CS8;
  1778. end;
  1779. {$else}
  1780. with tios do
  1781. begin
  1782. c_iflag:=c_iflag and (not (IMAXBEL or IXOFF or INPCK or BRKINT or
  1783. PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON or
  1784. IGNPAR));
  1785. c_iflag:=c_iflag OR IGNBRK;
  1786. c_oflag:=c_oflag and (not OPOST);
  1787. c_lflag:=c_lflag and (not (ECHO or ECHOE or ECHOK or ECHONL or ICANON or
  1788. ISIG or IEXTEN or NOFLSH or TOSTOP or PENDIN));
  1789. c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or (CS8 OR cread);
  1790. c_cc[VMIN]:=1;
  1791. c_cc[VTIME]:=0;
  1792. end;
  1793. {$endif}
  1794. end;
  1795. Function TCSendBreak(fd,duration:longint):boolean;
  1796. begin
  1797. {$ifndef BSD}
  1798. TCSendBreak:=IOCtl(fd,TCSBRK,pointer(duration));
  1799. {$else}
  1800. TCSendBreak:=IOCtl(fd,TIOCSBRK,0);
  1801. {$endif}
  1802. end;
  1803. Function TCSetPGrp(fd,id:longint):boolean;
  1804. begin
  1805. TCSetPGrp:=IOCtl(fd,TIOCSPGRP,pointer(id));
  1806. end;
  1807. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  1808. begin
  1809. TCGetPGrp:=IOCtl(fd,TIOCGPGRP,@id);
  1810. end;
  1811. Function TCDrain(fd:longint):boolean;
  1812. begin
  1813. {$ifndef BSD}
  1814. TCDrain:=IOCtl(fd,TCSBRK,pointer(1));
  1815. {$else}
  1816. TCDrain:=IOCtl(fd,TIOCDRAIN,0); {Should set timeout to 1 first?}
  1817. {$endif}
  1818. end;
  1819. Function TCFlow(fd,act:longint):boolean;
  1820. begin
  1821. {$ifndef BSD}
  1822. TCFlow:=IOCtl(fd,TCXONC,pointer(act));
  1823. {$else}
  1824. case act OF
  1825. TCOOFF : TCFlow:=Ioctl(fd,TIOCSTOP,0);
  1826. TCOOn : TCFlow:=IOctl(Fd,TIOCStart,0);
  1827. TCIOFF : {N/I}
  1828. end;
  1829. {$endif}
  1830. end;
  1831. Function TCFlush(fd,qsel:longint):boolean;
  1832. begin
  1833. {$ifndef BSD}
  1834. TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
  1835. {$else}
  1836. TCFlush:=IOCtl(fd,TIOCFLUSH,pointer(qsel));
  1837. {$endif}
  1838. end;
  1839. Function IsATTY(Handle:Longint):Boolean;
  1840. {
  1841. Check if the filehandle described by 'handle' is a TTY (Terminal)
  1842. }
  1843. var
  1844. t : Termios;
  1845. begin
  1846. IsAtty:=TCGetAttr(Handle,t);
  1847. end;
  1848. Function IsATTY(f: text):Boolean;
  1849. {
  1850. Idem as previous, only now for text variables.
  1851. }
  1852. begin
  1853. IsATTY:=IsaTTY(textrec(f).handle);
  1854. end;
  1855. function TTYName(Handle:Longint):string;
  1856. {
  1857. Return the name of the current tty described by handle f.
  1858. returns empty string in case of an error.
  1859. }
  1860. var
  1861. mydev,
  1862. myino : longint;
  1863. st : stat;
  1864. function mysearch(n:string): boolean;
  1865. {searches recursively for the device in the directory given by n,
  1866. returns true if found and sets the name of the device in ttyname}
  1867. var dirstream : pdir;
  1868. d : pdirent;
  1869. name : string;
  1870. st : stat;
  1871. begin
  1872. dirstream:=opendir(n);
  1873. if (linuxerror<>0) then
  1874. exit;
  1875. d:=Readdir(dirstream);
  1876. while (d<>nil) do
  1877. begin
  1878. name:=n+'/'+strpas(@(d^.name));
  1879. fstat(name,st);
  1880. if linuxerror=0 then
  1881. begin
  1882. if ((st.mode and $E000)=$4000) and { if it is a directory }
  1883. (strpas(@(d^.name))<>'.') and { but not ., .. and fd subdirs }
  1884. (strpas(@(d^.name))<>'..') and
  1885. (strpas(@(d^.name))<>'') and
  1886. (strpas(@(d^.name))<>'fd') then
  1887. begin {we found a directory, search inside it}
  1888. if mysearch(name) then
  1889. begin {the device is here}
  1890. closedir(dirstream); {then don't continue searching}
  1891. mysearch:=true;
  1892. exit;
  1893. end;
  1894. end
  1895. else if (d^.ino=myino) and (st.dev=mydev) then
  1896. begin
  1897. closedir(dirstream);
  1898. ttyname:=name;
  1899. mysearch:=true;
  1900. exit;
  1901. end;
  1902. end;
  1903. d:=Readdir(dirstream);
  1904. end;
  1905. closedir(dirstream);
  1906. mysearch:=false;
  1907. end;
  1908. begin
  1909. TTYName:='';
  1910. fstat(handle,st);
  1911. if (errno<>0) and isatty (handle) then
  1912. exit;
  1913. mydev:=st.dev;
  1914. myino:=st.ino;
  1915. mysearch('/dev');
  1916. end;
  1917. function TTYName(var F:Text):string;
  1918. {
  1919. Idem as previous, only now for text variables;
  1920. }
  1921. begin
  1922. TTYName:=TTYName(textrec(f).handle);
  1923. end;
  1924. {******************************************************************************
  1925. Utility calls
  1926. ******************************************************************************}
  1927. Function Octal(l:longint):longint;
  1928. {
  1929. Convert an octal specified number to decimal;
  1930. }
  1931. var
  1932. octnr,
  1933. oct : longint;
  1934. begin
  1935. octnr:=0;
  1936. oct:=0;
  1937. while (l>0) do
  1938. begin
  1939. oct:=oct or ((l mod 10) shl octnr);
  1940. l:=l div 10;
  1941. inc(octnr,3);
  1942. end;
  1943. Octal:=oct;
  1944. end;
  1945. Function StringToPPChar(S: PChar):ppchar;
  1946. var
  1947. nr : longint;
  1948. Buf : ^char;
  1949. p : ppchar;
  1950. begin
  1951. buf:=s;
  1952. nr:=0;
  1953. while(buf^<>#0) do
  1954. begin
  1955. while (buf^ in [' ',#9,#10]) do
  1956. inc(buf);
  1957. inc(nr);
  1958. while not (buf^ in [' ',#0,#9,#10]) do
  1959. inc(buf);
  1960. end;
  1961. getmem(p,nr*4+1);
  1962. StringToPPChar:=p;
  1963. if p=nil then
  1964. begin
  1965. LinuxError:=ESysENOMEM;
  1966. exit;
  1967. end;
  1968. buf:=s;
  1969. while (buf^<>#0) do
  1970. begin
  1971. while (buf^ in [' ',#9,#10]) do
  1972. begin
  1973. buf^:=#0;
  1974. inc(buf);
  1975. end;
  1976. p^:=buf;
  1977. inc(p);
  1978. p^:=nil;
  1979. while not (buf^ in [' ',#0,#9,#10]) do
  1980. inc(buf);
  1981. end;
  1982. end;
  1983. {
  1984. function FExpand (const Path: PathStr): PathStr;
  1985. - declared in fexpand.inc
  1986. }
  1987. {$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
  1988. {$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
  1989. const
  1990. LFNSupport = true;
  1991. FileNameCaseSensitive = true;
  1992. {$I fexpand.inc}
  1993. {$UNDEF FPC_FEXPAND_GETENVPCHAR}
  1994. {$UNDEF FPC_FEXPAND_TILDE}
  1995. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  1996. {
  1997. Searches for a file 'path' in the list of direcories in 'dirlist'.
  1998. returns an empty string if not found. Wildcards are NOT allowed.
  1999. If dirlist is empty, it is set to '.'
  2000. }
  2001. Var
  2002. NewDir : PathStr;
  2003. p1 : Longint;
  2004. Info : Stat;
  2005. Begin
  2006. {Replace ':' with ';'}
  2007. for p1:=1to length(dirlist) do
  2008. if dirlist[p1]=':' then
  2009. dirlist[p1]:=';';
  2010. {Check for WildCards}
  2011. If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
  2012. FSearch:='' {No wildcards allowed in these things.}
  2013. Else
  2014. Begin
  2015. Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
  2016. Repeat
  2017. p1:=Pos(';',DirList);
  2018. If p1=0 Then
  2019. p1:=255;
  2020. NewDir:=Copy(DirList,1,P1 - 1);
  2021. if NewDir[Length(NewDir)]<>'/' then
  2022. NewDir:=NewDir+'/';
  2023. NewDir:=NewDir+Path;
  2024. Delete(DirList,1,p1);
  2025. if FStat(NewDir,Info) then
  2026. Begin
  2027. If Pos('./',NewDir)=1 Then
  2028. Delete(NewDir,1,2);
  2029. {DOS strips off an initial .\}
  2030. End
  2031. Else
  2032. NewDir:='';
  2033. Until (DirList='') or (Length(NewDir) > 0);
  2034. FSearch:=NewDir;
  2035. End;
  2036. End;
  2037. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  2038. Var
  2039. DotPos,SlashPos,i : longint;
  2040. Begin
  2041. SlashPos:=0;
  2042. DotPos:=256;
  2043. i:=Length(Path);
  2044. While (i>0) and (SlashPos=0) Do
  2045. Begin
  2046. If (DotPos=256) and (Path[i]='.') Then
  2047. begin
  2048. DotPos:=i;
  2049. end;
  2050. If (Path[i]='/') Then
  2051. SlashPos:=i;
  2052. Dec(i);
  2053. End;
  2054. Ext:=Copy(Path,DotPos,255);
  2055. Dir:=Copy(Path,1,SlashPos);
  2056. Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
  2057. End;
  2058. Function Dirname(Const path:pathstr):pathstr;
  2059. {
  2060. This function returns the directory part of a complete path.
  2061. Unless the directory is root '/', The last character is not
  2062. a slash.
  2063. }
  2064. var
  2065. Dir : PathStr;
  2066. Name : NameStr;
  2067. Ext : ExtStr;
  2068. begin
  2069. FSplit(Path,Dir,Name,Ext);
  2070. if length(Dir)>1 then
  2071. Delete(Dir,length(Dir),1);
  2072. DirName:=Dir;
  2073. end;
  2074. Function StringToPPChar(Var S:String):ppchar;
  2075. {
  2076. Create a PPChar to structure of pchars which are the arguments specified
  2077. in the string S. Especially usefull for creating an ArgV for Exec-calls
  2078. Note that the string S is destroyed by this call.
  2079. }
  2080. begin
  2081. S:=S+#0;
  2082. StringToPPChar:=StringToPPChar(@S[1]);
  2083. end;
  2084. Function StringToPPChar(Var S:AnsiString):ppchar;
  2085. {
  2086. Create a PPChar to structure of pchars which are the arguments specified
  2087. in the string S. Especially usefull for creating an ArgV for Exec-calls
  2088. }
  2089. begin
  2090. StringToPPChar:=StringToPPChar(PChar(S));
  2091. end;
  2092. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  2093. {
  2094. This function returns the filename part of a complete path. If suf is
  2095. supplied, it is cut off the filename.
  2096. }
  2097. var
  2098. Dir : PathStr;
  2099. Name : NameStr;
  2100. Ext : ExtStr;
  2101. begin
  2102. FSplit(Path,Dir,Name,Ext);
  2103. if Suf<>Ext then
  2104. Name:=Name+Ext;
  2105. BaseName:=Name;
  2106. end;
  2107. Function FNMatch(const Pattern,Name:string):Boolean;
  2108. Var
  2109. LenPat,LenName : longint;
  2110. Function DoFNMatch(i,j:longint):Boolean;
  2111. Var
  2112. Found : boolean;
  2113. Begin
  2114. Found:=true;
  2115. While Found and (i<=LenPat) Do
  2116. Begin
  2117. Case Pattern[i] of
  2118. '?' : Found:=(j<=LenName);
  2119. '*' : Begin
  2120. {find the next character in pattern, different of ? and *}
  2121. while Found and (i<LenPat) do
  2122. begin
  2123. inc(i);
  2124. case Pattern[i] of
  2125. '*' : ;
  2126. '?' : begin
  2127. inc(j);
  2128. Found:=(j<=LenName);
  2129. end;
  2130. else
  2131. Found:=false;
  2132. end;
  2133. end;
  2134. {Now, find in name the character which i points to, if the * or ?
  2135. wasn't the last character in the pattern, else, use up all the
  2136. chars in name}
  2137. Found:=true;
  2138. if (i<=LenPat) then
  2139. begin
  2140. repeat
  2141. {find a letter (not only first !) which maches pattern[i]}
  2142. while (j<=LenName) and (name[j]<>pattern[i]) do
  2143. inc (j);
  2144. if (j<LenName) then
  2145. begin
  2146. if DoFnMatch(i+1,j+1) then
  2147. begin
  2148. i:=LenPat;
  2149. j:=LenName;{we can stop}
  2150. Found:=true;
  2151. end
  2152. else
  2153. inc(j);{We didn't find one, need to look further}
  2154. end;
  2155. until (j>=LenName);
  2156. end
  2157. else
  2158. j:=LenName;{we can stop}
  2159. end;
  2160. else {not a wildcard character in pattern}
  2161. Found:=(j<=LenName) and (pattern[i]=name[j]);
  2162. end;
  2163. inc(i);
  2164. inc(j);
  2165. end;
  2166. DoFnMatch:=Found and (j>LenName);
  2167. end;
  2168. Begin {start FNMatch}
  2169. LenPat:=Length(Pattern);
  2170. LenName:=Length(Name);
  2171. FNMatch:=DoFNMatch(1,1);
  2172. End;
  2173. Procedure Globfree(var p : pglob);
  2174. {
  2175. Release memory occupied by pglob structure, and names in it.
  2176. sets p to nil.
  2177. }
  2178. var
  2179. temp : pglob;
  2180. begin
  2181. while assigned(p) do
  2182. begin
  2183. temp:=p^.next;
  2184. if assigned(p^.name) then
  2185. freemem(p^.name);
  2186. dispose(p);
  2187. p:=temp;
  2188. end;
  2189. end;
  2190. Function Glob(Const path:pathstr):pglob;
  2191. {
  2192. Fills a tglob structure with entries matching path,
  2193. and returns a pointer to it. Returns nil on error,
  2194. linuxerror is set accordingly.
  2195. }
  2196. var
  2197. temp,
  2198. temp2 : string[255];
  2199. thedir : pdir;
  2200. buffer : pdirent;
  2201. root,
  2202. current : pglob;
  2203. begin
  2204. { Get directory }
  2205. temp:=dirname(path);
  2206. if temp='' then
  2207. temp:='.';
  2208. temp:=temp+#0;
  2209. thedir:=opendir(@temp[1]);
  2210. if thedir=nil then
  2211. begin
  2212. glob:=nil;
  2213. linuxerror:=errno;
  2214. exit;
  2215. end;
  2216. temp:=basename(path,''); { get the pattern }
  2217. if thedir^.fd<0 then
  2218. begin
  2219. linuxerror:=errno;
  2220. glob:=nil;
  2221. exit;
  2222. end;
  2223. {get the entries}
  2224. root:=nil;
  2225. current:=nil;
  2226. repeat
  2227. buffer:=Sys_readdir(thedir);
  2228. if buffer=nil then
  2229. break;
  2230. temp2:=strpas(@(buffer^.name[0]));
  2231. if fnmatch(temp,temp2) then
  2232. begin
  2233. if root=nil then
  2234. begin
  2235. new(root);
  2236. current:=root;
  2237. end
  2238. else
  2239. begin
  2240. new(current^.next);
  2241. current:=current^.next;
  2242. end;
  2243. if current=nil then
  2244. begin
  2245. linuxerror:=ESysENOMEM;
  2246. globfree(root);
  2247. break;
  2248. end;
  2249. current^.next:=nil;
  2250. getmem(current^.name,length(temp2)+1);
  2251. if current^.name=nil then
  2252. begin
  2253. linuxerror:=ESysENOMEM;
  2254. globfree(root);
  2255. break;
  2256. end;
  2257. move(buffer^.name[0],current^.name^,length(temp2)+1);
  2258. end;
  2259. until false;
  2260. closedir(thedir);
  2261. glob:=root;
  2262. end;
  2263. {--------------------------------
  2264. FiledescriptorSets
  2265. --------------------------------}
  2266. Procedure FD_Zero(var fds:fdSet);
  2267. {
  2268. Clear the set of filedescriptors
  2269. }
  2270. begin
  2271. FillChar(fds,sizeof(fdSet),0);
  2272. end;
  2273. Procedure FD_Clr(fd:longint;var fds:fdSet);
  2274. {
  2275. Remove fd from the set of filedescriptors
  2276. }
  2277. begin
  2278. fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
  2279. end;
  2280. Procedure FD_Set(fd:longint;var fds:fdSet);
  2281. {
  2282. Add fd to the set of filedescriptors
  2283. }
  2284. begin
  2285. fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
  2286. end;
  2287. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  2288. {
  2289. Test if fd is part of the set of filedescriptors
  2290. }
  2291. begin
  2292. FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
  2293. end;
  2294. Function GetFS (var T:Text):longint;
  2295. {
  2296. Get File Descriptor of a text file.
  2297. }
  2298. begin
  2299. if textrec(t).mode=fmclosed then
  2300. exit(-1)
  2301. else
  2302. GETFS:=textrec(t).Handle
  2303. end;
  2304. Function GetFS(Var F:File):longint;
  2305. {
  2306. Get File Descriptor of an unTyped file.
  2307. }
  2308. begin
  2309. { Handle and mode are on the same place in textrec and filerec. }
  2310. if filerec(f).mode=fmclosed then
  2311. exit(-1)
  2312. else
  2313. GETFS:=filerec(f).Handle
  2314. end;
  2315. {--------------------------------
  2316. Stat.Mode Macro's
  2317. --------------------------------}
  2318. Function S_ISLNK(m:word):boolean;
  2319. {
  2320. Check mode field of inode for link.
  2321. }
  2322. begin
  2323. S_ISLNK:=(m and STAT_IFMT)=STAT_IFLNK;
  2324. end;
  2325. Function S_ISREG(m:word):boolean;
  2326. {
  2327. Check mode field of inode for regular file.
  2328. }
  2329. begin
  2330. S_ISREG:=(m and STAT_IFMT)=STAT_IFREG;
  2331. end;
  2332. Function S_ISDIR(m:word):boolean;
  2333. {
  2334. Check mode field of inode for directory.
  2335. }
  2336. begin
  2337. S_ISDIR:=(m and STAT_IFMT)=STAT_IFDIR;
  2338. end;
  2339. Function S_ISCHR(m:word):boolean;
  2340. {
  2341. Check mode field of inode for character device.
  2342. }
  2343. begin
  2344. S_ISCHR:=(m and STAT_IFMT)=STAT_IFCHR;
  2345. end;
  2346. Function S_ISBLK(m:word):boolean;
  2347. {
  2348. Check mode field of inode for block device.
  2349. }
  2350. begin
  2351. S_ISBLK:=(m and STAT_IFMT)=STAT_IFBLK;
  2352. end;
  2353. Function S_ISFIFO(m:word):boolean;
  2354. {
  2355. Check mode field of inode for named pipe (FIFO).
  2356. }
  2357. begin
  2358. S_ISFIFO:=(m and STAT_IFMT)=STAT_IFIFO;
  2359. end;
  2360. Function S_ISSOCK(m:word):boolean;
  2361. {
  2362. Check mode field of inode for socket.
  2363. }
  2364. begin
  2365. S_ISSOCK:=(m and STAT_IFMT)=STAT_IFSOCK;
  2366. end;
  2367. {--------------------------------
  2368. Memory functions
  2369. --------------------------------}
  2370. {$IFDEF I386}
  2371. Procedure WritePort (Port : Longint; Value : Byte);
  2372. {
  2373. Writes 'Value' to port 'Port'
  2374. }
  2375. begin
  2376. asm
  2377. movl port,%edx
  2378. movb value,%al
  2379. outb %al,%dx
  2380. end ['EAX','EDX'];
  2381. end;
  2382. Procedure WritePort (Port : Longint; Value : Word);
  2383. {
  2384. Writes 'Value' to port 'Port'
  2385. }
  2386. begin
  2387. asm
  2388. movl port,%edx
  2389. movw value,%ax
  2390. outw %ax,%dx
  2391. end ['EAX','EDX'];
  2392. end;
  2393. Procedure WritePort (Port : Longint; Value : Longint);
  2394. {
  2395. Writes 'Value' to port 'Port'
  2396. }
  2397. begin
  2398. asm
  2399. movl port,%edx
  2400. movl value,%eax
  2401. outl %eax,%dx
  2402. end ['EAX','EDX'];
  2403. end;
  2404. Procedure WritePortB (Port : Longint; Value : Byte);
  2405. {
  2406. Writes 'Value' to port 'Port'
  2407. }
  2408. begin
  2409. asm
  2410. movl port,%edx
  2411. movb value,%al
  2412. outb %al,%dx
  2413. end ['EAX','EDX'];
  2414. end;
  2415. Procedure WritePortW (Port : Longint; Value : Word);
  2416. {
  2417. Writes 'Value' to port 'Port'
  2418. }
  2419. begin
  2420. asm
  2421. movl port,%edx
  2422. movw value,%ax
  2423. outw %ax,%dx
  2424. end ['EAX','EDX'];
  2425. end;
  2426. Procedure WritePortL (Port : Longint; Value : Longint);
  2427. {
  2428. Writes 'Value' to port 'Port'
  2429. }
  2430. begin
  2431. asm
  2432. movl port,%edx
  2433. movl value,%eax
  2434. outl %eax,%dx
  2435. end ['EAX','EDX'];
  2436. end;
  2437. Procedure WritePortl (Port : Longint; Var Buf; Count: longint);
  2438. {
  2439. Writes 'Count' longints from 'Buf' to Port
  2440. }
  2441. begin
  2442. asm
  2443. movl count,%ecx
  2444. movl buf,%esi
  2445. movl port,%edx
  2446. cld
  2447. rep
  2448. outsl
  2449. end ['ECX','ESI','EDX'];
  2450. end;
  2451. Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
  2452. {
  2453. Writes 'Count' words from 'Buf' to Port
  2454. }
  2455. begin
  2456. asm
  2457. movl count,%ecx
  2458. movl buf,%esi
  2459. movl port,%edx
  2460. cld
  2461. rep
  2462. outsw
  2463. end ['ECX','ESI','EDX'];
  2464. end;
  2465. Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
  2466. {
  2467. Writes 'Count' bytes from 'Buf' to Port
  2468. }
  2469. begin
  2470. asm
  2471. movl count,%ecx
  2472. movl buf,%esi
  2473. movl port,%edx
  2474. cld
  2475. rep
  2476. outsb
  2477. end ['ECX','ESI','EDX'];
  2478. end;
  2479. Procedure ReadPort (Port : Longint; Var Value : Byte);
  2480. {
  2481. Reads 'Value' from port 'Port'
  2482. }
  2483. begin
  2484. asm
  2485. movl port,%edx
  2486. inb %dx,%al
  2487. movl value,%edx
  2488. movb %al,(%edx)
  2489. end ['EAX','EDX'];
  2490. end;
  2491. Procedure ReadPort (Port : Longint; Var Value : Word);
  2492. {
  2493. Reads 'Value' from port 'Port'
  2494. }
  2495. begin
  2496. asm
  2497. movl port,%edx
  2498. inw %dx,%ax
  2499. movl value,%edx
  2500. movw %ax,(%edx)
  2501. end ['EAX','EDX'];
  2502. end;
  2503. Procedure ReadPort (Port : Longint; Var Value : Longint);
  2504. {
  2505. Reads 'Value' from port 'Port'
  2506. }
  2507. begin
  2508. asm
  2509. movl port,%edx
  2510. inl %dx,%eax
  2511. movl value,%edx
  2512. movl %eax,(%edx)
  2513. end ['EAX','EDX'];
  2514. end;
  2515. function ReadPortB (Port : Longint): Byte; assembler;
  2516. {
  2517. Reads a byte from port 'Port'
  2518. }
  2519. asm
  2520. xorl %eax,%eax
  2521. movl port,%edx
  2522. inb %dx,%al
  2523. end ['EAX','EDX'];
  2524. function ReadPortW (Port : Longint): Word; assembler;
  2525. {
  2526. Reads a word from port 'Port'
  2527. }
  2528. asm
  2529. xorl %eax,%eax
  2530. movl port,%edx
  2531. inw %dx,%ax
  2532. end ['EAX','EDX'];
  2533. function ReadPortL (Port : Longint): LongInt; assembler;
  2534. {
  2535. Reads a LongInt from port 'Port'
  2536. }
  2537. asm
  2538. movl port,%edx
  2539. inl %dx,%eax
  2540. end ['EAX','EDX'];
  2541. Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
  2542. {
  2543. Reads 'Count' longints from port 'Port' to 'Buf'.
  2544. }
  2545. begin
  2546. asm
  2547. movl count,%ecx
  2548. movl buf,%edi
  2549. movl port,%edx
  2550. cld
  2551. rep
  2552. insl
  2553. end ['ECX','EDI','EDX'];
  2554. end;
  2555. Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
  2556. {
  2557. Reads 'Count' words from port 'Port' to 'Buf'.
  2558. }
  2559. begin
  2560. asm
  2561. movl count,%ecx
  2562. movl buf,%edi
  2563. movl port,%edx
  2564. cld
  2565. rep
  2566. insw
  2567. end ['ECX','EDI','EDX'];
  2568. end;
  2569. Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
  2570. {
  2571. Reads 'Count' bytes from port 'Port' to 'Buf'.
  2572. }
  2573. begin
  2574. asm
  2575. movl count,%ecx
  2576. movl buf,%edi
  2577. movl port,%edx
  2578. cld
  2579. rep
  2580. insb
  2581. end ['ECX','EDI','EDX'];
  2582. end;
  2583. {$ENDIF}
  2584. Initialization
  2585. InitLocalTime;
  2586. finalization
  2587. DoneLocalTime;
  2588. End.
  2589. {
  2590. $Log$
  2591. Revision 1.28 2003-03-11 08:26:50 michael
  2592. * stringtoppchar should use tabs instead of backspace as delimiter
  2593. Revision 1.27 2003/01/05 19:11:32 marco
  2594. * small changes originating from introduction of Baseunix to FreeBSD
  2595. Revision 1.26 2002/12/18 17:52:07 peter
  2596. * replaced some Fp with Sys_ to get cycle working
  2597. Revision 1.25 2002/12/18 16:50:39 marco
  2598. * Unix RTL generic parts. Linux working, *BSD will follow shortly
  2599. Revision 1.24 2002/09/13 13:03:27 jonas
  2600. * fixed buffer overflow error in StringToPPChar(), detected using
  2601. DIOTA (http://www.elis/rug.ac.be/~ronsse/diota) (which I also work on :)
  2602. (merged)
  2603. Revision 1.23 2002/09/07 16:01:27 peter
  2604. * old logs removed and tabs fixed
  2605. Revision 1.22 2002/08/06 13:30:46 sg
  2606. * replaced some Longints with Cardinals, to mach the C headers
  2607. * updated the termios record
  2608. Revision 1.21 2002/03/06 11:34:04 michael
  2609. + Forgot to patch linux.pp
  2610. Revision 1.20 2002/01/02 12:22:54 marco
  2611. * Removed ifdef arround getepoch.
  2612. }