linux.pp 74 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1993,97 by Michael Van Canneyt,
  4. member of the Free Pascal development team.
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY;without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. Unit Linux;
  12. Interface
  13. { Get Types and Constants }
  14. {$i sysconst.inc}
  15. {$i systypes.inc}
  16. { Get System call numbers and error-numbers}
  17. {$i sysnr.inc}
  18. {$i errno.inc}
  19. var
  20. ErrNo,
  21. LinuxError : Longint;
  22. {********************
  23. Process
  24. ********************}
  25. Const
  26. { For getting/setting priority }
  27. Prio_Process = 0;
  28. Prio_PGrp = 1;
  29. Prio_User = 2;
  30. {********************
  31. File
  32. ********************}
  33. Const
  34. P_IN = 1;
  35. P_OUT = 2;
  36. Const
  37. LOCK_SH = 1;
  38. LOCK_EX = 2;
  39. LOCK_UN = 8;
  40. LOCK_NB = 4;
  41. Type
  42. Tpipe = array[1..2] of longint;
  43. pglob = ^tglob;
  44. tglob = record
  45. name : pchar;
  46. next : pglob;
  47. end;
  48. ComStr = String[255];
  49. PathStr = String[255];
  50. DirStr = String[255];
  51. NameStr = String[255];
  52. ExtStr = String[255];
  53. const
  54. { For testing access rights }
  55. R_OK = 4;
  56. W_OK = 2;
  57. X_OK = 1;
  58. F_OK = 0;
  59. { For File control mechanism }
  60. F_GetFd = 1;
  61. F_SetFd = 2;
  62. F_GetFl = 3;
  63. F_SetFl = 4;
  64. F_GetLk = 5;
  65. F_SetLk = 6;
  66. F_SetLkW = 7;
  67. F_GetOwn = 8;
  68. F_SetOwn = 9;
  69. {********************
  70. Signal
  71. ********************}
  72. Const
  73. { For sending a signal }
  74. SA_NOCLDSTOP = 1;
  75. SA_SHIRQ = $04000000;
  76. SA_STACK = $08000000;
  77. SA_RESTART = $10000000;
  78. SA_INTERRUPT = $20000000;
  79. SA_NOMASK = $40000000;
  80. SA_ONESHOT = $80000000;
  81. SIG_BLOCK = 0;
  82. SIG_UNBLOCK = 1;
  83. SIG_SETMASK = 2;
  84. SIG_DFL = 0 ;
  85. SIG_IGN = 1 ;
  86. SIG_ERR = -1 ;
  87. SIGHUP = 1;
  88. SIGINT = 2;
  89. SIGQUIT = 3;
  90. SIGILL = 4;
  91. SIGTRAP = 5;
  92. SIGABRT = 6;
  93. SIGIOT = 6;
  94. SIGBUS = 7;
  95. SIGFPE = 8;
  96. SIGKILL = 9;
  97. SIGUSR1 = 10;
  98. SIGSEGV = 11;
  99. SIGUSR2 = 12;
  100. SIGPIPE = 13;
  101. SIGALRM = 14;
  102. SIGTerm = 15;
  103. SIGSTKFLT = 16;
  104. SIGCHLD = 17;
  105. SIGCONT = 18;
  106. SIGSTOP = 19;
  107. SIGTSTP = 20;
  108. SIGTTIN = 21;
  109. SIGTTOU = 22;
  110. SIGURG = 23;
  111. SIGXCPU = 24;
  112. SIGXFSZ = 25;
  113. SIGVTALRM = 26;
  114. SIGPROF = 27;
  115. SIGWINCH = 28;
  116. SIGIO = 29;
  117. SIGPOLL = SIGIO;
  118. SIGPWR = 30;
  119. SIGUNUSED = 31;
  120. Type
  121. SignalHandler = Procedure(Sig : Integer);
  122. PSignalHandler = ^SignalHandler;
  123. SignalRestorer = Procedure;
  124. PSignalRestorer = ^SignalRestorer;
  125. SigSet = Integer;
  126. PSigSet = ^SigSet;
  127. {$PACKRECORDS 1}
  128. SigActionRec = record
  129. Sa_Handler : ^SignalHandler;
  130. Sa_Mask : longint;
  131. Sa_Flags : Integer;
  132. Sa_restorer : ^SignalRestorer;{ Obsolete - Don't use }
  133. end;
  134. PSigActionRec = ^SigActionRec;
  135. {$PACKRECORDS NORMAL}
  136. {********************
  137. IOCtl(TermIOS)
  138. ********************}
  139. Const
  140. { Amount of Control Chars }
  141. NCCS = 19;
  142. NCC = 8;
  143. { For Terminal handling }
  144. TCGETS = $5401;
  145. TCSETS = $5402;
  146. TCSETSW = $5403;
  147. TCSETSF = $5404;
  148. TCGETA = $5405;
  149. TCSETA = $5406;
  150. TCSETAW = $5407;
  151. TCSETAF = $5408;
  152. TCSBRK = $5409;
  153. TCXONC = $540A;
  154. TCFLSH = $540B;
  155. TIOCEXCL = $540C;
  156. TIOCNXCL = $540D;
  157. TIOCSCTTY = $540E;
  158. TIOCGPGRP = $540F;
  159. TIOCSPGRP = $5410;
  160. TIOCOUTQ = $5411;
  161. TIOCSTI = $5412;
  162. TIOCGWINSZ = $5413;
  163. TIOCSWINSZ = $5414;
  164. TIOCMGET = $5415;
  165. TIOCMBIS = $5416;
  166. TIOCMBIC = $5417;
  167. TIOCMSET = $5418;
  168. TIOCGSOFTCAR = $5419;
  169. TIOCSSOFTCAR = $541A;
  170. FIONREAD = $541B;
  171. TIOCINQ = FIONREAD;
  172. TIOCLINUX = $541C;
  173. TIOCCONS = $541D;
  174. TIOCGSERIAL = $541E;
  175. TIOCSSERIAL = $541F;
  176. TIOCPKT = $5420;
  177. FIONBIO = $5421;
  178. TIOCNOTTY = $5422;
  179. TIOCSETD = $5423;
  180. TIOCGETD = $5424;
  181. TCSBRKP = $5425;
  182. TIOCTTYGSTRUCT = $5426;
  183. FIONCLEX = $5450;
  184. FIOCLEX = $5451;
  185. FIOASYNC = $5452;
  186. TIOCSERCONFIG = $5453;
  187. TIOCSERGWILD = $5454;
  188. TIOCSERSWILD = $5455;
  189. TIOCGLCKTRMIOS = $5456;
  190. TIOCSLCKTRMIOS = $5457;
  191. TIOCSERGSTRUCT = $5458;
  192. TIOCSERGETLSR = $5459;
  193. TIOCSERGETMULTI = $545A;
  194. TIOCSERSETMULTI = $545B;
  195. TIOCMIWAIT = $545C;
  196. TIOCGICOUNT = $545D;
  197. TIOCPKT_DATA = 0;
  198. TIOCPKT_FLUSHREAD = 1;
  199. TIOCPKT_FLUSHWRITE = 2;
  200. TIOCPKT_STOP = 4;
  201. TIOCPKT_START = 8;
  202. TIOCPKT_NOSTOP = 16;
  203. TIOCPKT_DOSTOP = 32;
  204. Type
  205. {$PACKRECORDS 1}
  206. winsize = record
  207. ws_row,
  208. ws_col,
  209. ws_xpixel,
  210. ws_ypixel : byte;
  211. end;
  212. TermIO = record
  213. c_iflag, { input mode flags }
  214. c_oflag, { output mode flags }
  215. c_cflag, { control mode flags }
  216. c_lflag : Word; { local mode flags }
  217. c_line : Word; { line discipline - careful, only High byte in use}
  218. c_cc : array [0..NCC-1] of char;{ control characters }
  219. end;
  220. TermIOS = record
  221. c_iflag,
  222. c_oflag,
  223. c_cflag,
  224. c_lflag : longint;
  225. c_line : char;
  226. c_cc : array[0..NCCS-1] of byte;
  227. end;
  228. {$PACKRECORDS 2}
  229. const
  230. InitCC:array[0..NCCS-1] of byte=(3,34,177,25,4,0,1,0,21,23,32,0,22,17,27,26,0,0,0);
  231. const
  232. {c_cc characters}
  233. VINTR = 0;
  234. VQUIT = 1;
  235. VERASE = 2;
  236. VKILL = 3;
  237. VEOF = 4;
  238. VTIME = 5;
  239. VMIN = 6;
  240. VSWTC = 7;
  241. VSTART = 8;
  242. VSTOP = 9;
  243. VSUSP = 10;
  244. VEOL = 11;
  245. VREPRINT = 12;
  246. VDISCARD = 13;
  247. VWERASE = 14;
  248. VLNEXT = 15;
  249. VEOL2 = 16;
  250. {c_iflag bits}
  251. IGNBRK = $0000001;
  252. BRKINT = $0000002;
  253. IGNPAR = $0000004;
  254. PARMRK = $0000008;
  255. INPCK = $0000010;
  256. ISTRIP = $0000020;
  257. INLCR = $0000040;
  258. IGNCR = $0000080;
  259. ICRNL = $0000100;
  260. IUCLC = $0000200;
  261. IXON = $0000400;
  262. IXANY = $0000800;
  263. IXOFF = $0001000;
  264. IMAXBEL = $0002000;
  265. {c_oflag bits}
  266. OPOST = $0000001;
  267. OLCUC = $0000002;
  268. ONLCR = $0000004;
  269. OCRNL = $0000008;
  270. ONOCR = $0000010;
  271. ONLRET = $0000020;
  272. OFILL = $0000040;
  273. OFDEL = $0000080;
  274. NLDLY = $0000100;
  275. NL0 = $0000000;
  276. NL1 = $0000100;
  277. CRDLY = $0000600;
  278. CR0 = $0000000;
  279. CR1 = $0000200;
  280. CR2 = $0000400;
  281. CR3 = $0000600;
  282. TABDLY = $0001800;
  283. TAB0 = $0000000;
  284. TAB1 = $0000800;
  285. TAB2 = $0001000;
  286. TAB3 = $0001800;
  287. XTABS = $0001800;
  288. BSDLY = $0002000;
  289. BS0 = $0000000;
  290. BS1 = $0002000;
  291. VTDLY = $0004000;
  292. VT0 = $0000000;
  293. VT1 = $0004000;
  294. FFDLY = $0008000;
  295. FF0 = $0000000;
  296. FF1 = $0008000;
  297. {c_cflag bits}
  298. CBAUD = $000100F;
  299. B0 = $0000000;
  300. B50 = $0000001;
  301. B75 = $0000002;
  302. B110 = $0000003;
  303. B134 = $0000004;
  304. B150 = $0000005;
  305. B200 = $0000006;
  306. B300 = $0000007;
  307. B600 = $0000008;
  308. B1200 = $0000009;
  309. B1800 = $000000A;
  310. B2400 = $000000B;
  311. B4800 = $000000C;
  312. B9600 = $000000D;
  313. B19200 = $000000E;
  314. B38400 = $000000F;
  315. EXTA = B19200;
  316. EXTB = B38400;
  317. CSIZE = $0000030;
  318. CS5 = $0000000;
  319. CS6 = $0000010;
  320. CS7 = $0000020;
  321. CS8 = $0000030;
  322. CSTOPB = $0000040;
  323. CREAD = $0000080;
  324. PARENB = $0000100;
  325. PARODD = $0000200;
  326. HUPCL = $0000400;
  327. CLOCAL = $0000800;
  328. CBAUDEX = $0001000;
  329. B57600 = $0001001;
  330. B115200 = $0001002;
  331. B230400 = $0001003;
  332. B460800 = $0001004;
  333. CIBAUD = $100F0000;
  334. CMSPAR = $40000000;
  335. CRTSCTS = $80000000;
  336. {c_lflag bits}
  337. ISIG = $0000001;
  338. ICANON = $0000002;
  339. XCASE = $0000004;
  340. ECHO = $0000008;
  341. ECHOE = $0000010;
  342. ECHOK = $0000020;
  343. ECHONL = $0000040;
  344. NOFLSH = $0000080;
  345. TOSTOP = $0000100;
  346. ECHOCTL = $0000200;
  347. ECHOPRT = $0000400;
  348. ECHOKE = $0000800;
  349. FLUSHO = $0001000;
  350. PENDIN = $0004000;
  351. IEXTEN = $0008000;
  352. {c_line bits}
  353. TIOCM_LE = $001;
  354. TIOCM_DTR = $002;
  355. TIOCM_RTS = $004;
  356. TIOCM_ST = $008;
  357. TIOCM_SR = $010;
  358. TIOCM_CTS = $020;
  359. TIOCM_CAR = $040;
  360. TIOCM_RNG = $080;
  361. TIOCM_DSR = $100;
  362. TIOCM_CD = TIOCM_CAR;
  363. TIOCM_RI = TIOCM_RNG;
  364. TIOCM_OUT1 = $2000;
  365. TIOCM_OUT2 = $4000;
  366. {TCSetAttr}
  367. TCSANOW = 0;
  368. TCSADRAIN = 1;
  369. TCSAFLUSH = 2;
  370. {TCFlow}
  371. TCOOFF = 0;
  372. TCOON = 1;
  373. TCIOFF = 2;
  374. TCION = 3;
  375. {TCFlush}
  376. TCIFLUSH = 0;
  377. TCOFLUSH = 1;
  378. TCIOFLUSH = 2;
  379. {********************
  380. Info
  381. ********************}
  382. Type
  383. {$PACKRECORDS 1}
  384. utimbuf = record
  385. actime,modtime : Longint;
  386. end;
  387. TSysinfo = record
  388. uptime : longint;
  389. loads : array[1..3] of longint;
  390. totalram,
  391. freeram,
  392. sharedram,
  393. bufferram,
  394. totalswap,
  395. freeswap : longint;
  396. procs : integer;
  397. s : string[18];
  398. end;
  399. {$PACKRECORDS 2}
  400. {******************************************************************************
  401. Procedure/Functions
  402. ******************************************************************************}
  403. Function SysCall(callnr:longint;var regs:SysCallregs):longint;
  404. {**************************
  405. Time/Date Handling
  406. ***************************}
  407. Function GetEpochTime:longint;
  408. Procedure GetTimeOfDay(var tv:timeval;var tz:timezone);
  409. Function GetTimeOfDay: longint;
  410. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  411. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  412. Procedure GetTime(Var Hour,Minute,Second:Word);
  413. Procedure GetDate(Var Year,Month,Day:Word);
  414. { For compatibility with earlier versions }
  415. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Integer);
  416. Function LocalToEpoch(year,month,day,hour,minute,second:Integer):Longint;
  417. Procedure GetTime(Var Hour,Minute,Second:Integer);
  418. Procedure GetDate(Var Year,Month,Day:Integer);
  419. {**************************
  420. Process Handling
  421. ***************************}
  422. Procedure Execve(Path:pathstr;args:ppchar;ep:ppchar);
  423. Procedure Execv(const path:pathstr;args:ppchar);
  424. Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
  425. Procedure Execl(const Todo:string);
  426. Procedure Execle(Todo:string;Ep:ppchar);
  427. Procedure Execlp(Todo:string;Ep:ppchar);
  428. Function Shell(Command:String):Longint;
  429. Function Fork:longint;
  430. Function WaitPid(Pid:longint;Status:pointer;Options:Integer):Longint;
  431. Procedure Nice(N:integer);
  432. Function GetPriority(Which,Who:Integer):integer;
  433. Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
  434. Function GetPid:LongInt;
  435. Function GetPPid:LongInt;
  436. Function GetUid:Longint;
  437. Function GetEUid:Longint;
  438. Function GetGid:Longint;
  439. Function GetEGid:Longint;
  440. {**************************
  441. File Handling
  442. ***************************}
  443. Function fdOpen(pathname:string;flags:longint):longint;
  444. Function fdOpen(pathname:string;flags,mode:longint):longint;
  445. Function fdOpen(pathname:pchar;flags:longint):longint;
  446. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  447. Function fdClose(fd:longint):boolean;
  448. Function fdRead(fd:longint;var buf;size:longint):longint;
  449. Function fdWrite(fd:longint;var buf;size:longint):longint;
  450. Function fdTruncate(fd,size:longint):boolean;
  451. Function fdSeek (fd,pos,seektype :longint): longint;
  452. Function fdFlush (fd : Longint) : Boolean;
  453. Function Link(OldPath,NewPath:pathstr):boolean;
  454. Function SymLink(OldPath,NewPath:pathstr):boolean;
  455. Function UnLink(Path:pathstr):boolean;
  456. Function UnLink(Path:pchar):Boolean;
  457. Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
  458. Function Chmod(path:pathstr;Newmode:longint):boolean;
  459. Function Utime(path:pathstr;utim:utimbuf):boolean;
  460. Function Access(Path:Pathstr ;mode:integer):boolean;
  461. Function Umask(Mask:Integer):integer;
  462. Function Flock (fd,mode : longint) : boolean;
  463. Function Flock (var T : text;mode : longint) : boolean;
  464. Function Flock (var F : File;mode : longint) : boolean;
  465. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  466. Function FStat(Fd:longint;Var Info:stat):Boolean;
  467. Function FStat(var F:Text;Var Info:stat):Boolean;
  468. Function FStat(var F:File;Var Info:stat):Boolean;
  469. Function Lstat(Filename: PathStr;var Info:stat):Boolean;
  470. Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
  471. Function FSStat(Fd: Longint;Var Info:statfs):Boolean;
  472. Function Fcntl(Fd:Text;Cmd:Integer):integer;
  473. Procedure Fcntl(Fd:Text;Cmd:Integer;Arg:Longint);
  474. Function Dup(oldfile,newfile:longint):Boolean;
  475. Function Dup(var oldfile,newfile:text):Boolean;
  476. Function Dup(var oldfile,newfile:file):Boolean;
  477. Function Dup2(oldfile,newfile:longint):Boolean;
  478. Function Dup2(var oldfile,newfile:text):Boolean;
  479. Function Dup2(var oldfile,newfile:file):Boolean;
  480. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
  481. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  482. Function SelectText(var T:Text;TimeOut :PTimeVal):Longint;
  483. {**************************
  484. Directory Handling
  485. ***************************}
  486. Function OpenDir(f:pchar):pdir;
  487. Function OpenDir(f: String):pdir;
  488. function CloseDir(p:pdir):integer;
  489. Function ReadDir(p:pdir):pdirent;
  490. procedure SeekDir(p:pdir;off:longint);
  491. function TellDir(p:pdir):longint;
  492. {**************************
  493. Pipe/Fifo/Stream
  494. ***************************}
  495. Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
  496. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  497. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  498. Function PClose(Var F:text) : longint;
  499. Function PClose(Var F:file) : longint;
  500. Procedure POpen(var F:text;const Prog:String;rw:char);
  501. Procedure POpen(var F:file;const Prog:String;rw:char);
  502. Function mkFifo(pathname:string;mode:longint):boolean;
  503. Procedure AssignStream(Var StreamIn,Streamout:text;Const Prog:String);
  504. {**************************
  505. General information
  506. ***************************}
  507. Function GetDomainName:String;
  508. Function GetHostName:String;
  509. Function GetEnv(P:string):Pchar;
  510. Function Sysinfo(var Info:TSysinfo):Boolean;
  511. Function Uname(var unamerec:utsname):Boolean;
  512. {**************************
  513. Signal
  514. ***************************}
  515. Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
  516. Procedure SigProcMask (How:Integer;SSet,OldSSet:PSigSet);
  517. Function SigPending:SigSet;
  518. Procedure SigSuspend(Mask:Sigset);
  519. Function Signal(Signum:Integer;Handler:PSignalHandler):PSignalHandler;
  520. Function Kill(Pid:longint;Sig:integer):integer;
  521. {**************************
  522. IOCtl/Termios Functions
  523. ***************************}
  524. Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
  525. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  526. Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
  527. Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
  528. Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
  529. Procedure CFMakeRaw(var tios:TermIOS);
  530. Function TCSendBreak(fd,duration:longint):boolean;
  531. Function TCSetPGrp(fd,id:longint):boolean;
  532. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  533. Function TCFlush(fd,qsel:longint):boolean;
  534. Function TCDrain(fd:longint):boolean;
  535. Function TCFlow(fd,act:longint):boolean;
  536. Function IsATTY(Handle:Longint):Boolean;
  537. Function IsATTY(f:text):Boolean;
  538. function TTYname(Handle:Longint):string;
  539. function TTYname(var F:Text):string;
  540. {**************************
  541. Utility functions
  542. ***************************}
  543. Function Octal(l:longint):longint;
  544. Function FExpand(Const Path: PathStr):PathStr;
  545. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  546. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  547. Function Dirname(Const path:pathstr):pathstr;
  548. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  549. Function FNMatch(const Pattern,Name:string):Boolean;
  550. Function Glob(Const path:pathstr):pglob;
  551. Procedure Globfree(var p:pglob);
  552. Function StringToPPChar(Var S:STring):ppchar;
  553. Function GetFS(var T:Text):longint;
  554. Function GetFS(Var F:File):longint;
  555. {Filedescriptorsets}
  556. Procedure FD_Zero(var fds:fdSet);
  557. Procedure FD_Clr(fd:longint;var fds:fdSet);
  558. Procedure FD_Set(fd:longint;var fds:fdSet);
  559. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  560. {Stat.Mode Types}
  561. Function S_ISLNK(m:integer):boolean;
  562. Function S_ISREG(m:integer):boolean;
  563. Function S_ISDIR(m:integer):boolean;
  564. Function S_ISCHR(m:integer):boolean;
  565. Function S_ISBLK(m:integer):boolean;
  566. Function S_ISFIFO(m:integer):boolean;
  567. Function S_ISSOCK(m:integer):boolean;
  568. {******************************************************************************
  569. Implementation
  570. ******************************************************************************}
  571. Implementation
  572. Uses Strings;
  573. var
  574. LocalTZ:TimeZone;
  575. { Get the definitions of textrec and filerec }
  576. {$i textrec.inc}
  577. {$i filerec.inc}
  578. { Raw System calls are in Syscalls.inc}
  579. {$i syscalls.inc}
  580. {******************************************************************************
  581. Process related calls
  582. ******************************************************************************}
  583. Function Fork:longint;
  584. {
  585. This function issues the 'fork' System call. the program is duplicated in memory
  586. and Execution continues in parent and child process.
  587. In the parent process, fork returns the PID of the child. In the child process,
  588. zero is returned.
  589. A negative value indicates that an error has occurred, the error is returned in
  590. LinuxError.
  591. }
  592. var
  593. regs:SysCallregs;
  594. begin
  595. Fork:=SysCall(SysCall_nr_fork,regs);
  596. LinuxError:=Errno;
  597. End;
  598. Procedure Execve(path:pathstr;args:ppchar;ep:ppchar);
  599. {
  600. Replaces the current program by the program specified in path,
  601. arguments in args are passed to Execve.
  602. environment specified in ep is passed on.
  603. }
  604. var
  605. regs:SysCallregs;
  606. begin
  607. path:=path+#0;
  608. regs.reg2:=longint(@path[1]);
  609. regs.reg3:=longint(args);
  610. regs.reg4:=longint(ep);
  611. SysCall(SysCall_nr_Execve,regs);
  612. { This only gets set when the call fails, otherwise we don't get here ! }
  613. Linuxerror:=errno;
  614. end;
  615. Procedure Execv(const path:pathstr;args:ppchar);
  616. {
  617. Replaces the current program by the program specified in path,
  618. arguments in args are passed to Execve.
  619. the current environment is passed on.
  620. }
  621. begin
  622. Execve(path,args,envp); {On error linuxerror will get set there}
  623. end;
  624. Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
  625. {
  626. This does the same as Execve, only it searches the PATH environment
  627. for the place of the Executable, except when Path starts with a slash.
  628. if the PATH environment variable is unavailable, the path is set to '.'
  629. }
  630. var
  631. thepath : string;
  632. begin
  633. if path[1]<>'/' then
  634. begin
  635. Thepath:=strpas(getenv('PATH'));
  636. if thepath='' then
  637. thepath:='.';
  638. Path:=FSearch(path,thepath)
  639. end
  640. else
  641. Path:='';
  642. if Path='' then
  643. linuxerror:=Sys_enoent
  644. else
  645. Execve(Path,args,ep);{On error linuxerror will get set there}
  646. end;
  647. Procedure Execle(Todo:string;Ep:ppchar);
  648. {
  649. This procedure takes the string 'Todo', parses it for command and
  650. command options, and Executes the command with the given options.
  651. The string 'Todo' shoud be of the form 'command options', options
  652. separated by commas.
  653. the PATH environment is not searched for 'command'.
  654. The specified environment(in 'ep') is passed on to command
  655. }
  656. var
  657. p : ppchar;
  658. begin
  659. p:=StringToPPChar(ToDo);
  660. if (p=nil) or (p^=nil) then
  661. exit;
  662. ExecVE(StrPas(p^),p,EP);
  663. end;
  664. Procedure Execl(const Todo:string);
  665. {
  666. This procedure takes the string 'Todo', parses it for command and
  667. command options, and Executes the command with the given options.
  668. The string 'Todo' shoud be of the form 'command options', options
  669. separated by commas.
  670. the PATH environment is not searched for 'command'.
  671. The current environment is passed on to command
  672. }
  673. begin
  674. ExecLE(ToDo,EnvP);
  675. end;
  676. Procedure Execlp(Todo:string;Ep:ppchar);
  677. {
  678. This procedure takes the string 'Todo', parses it for command and
  679. command options, and Executes the command with the given options.
  680. The string 'Todo' shoud be of the form 'command options', options
  681. separated by commas.
  682. the PATH environment is searched for 'command'.
  683. The specified environment (in 'ep') is passed on to command
  684. }
  685. var
  686. p : ppchar;
  687. begin
  688. p:=StringToPPchar(todo);
  689. if (p=nil) or (p^=nil) then
  690. exit;
  691. ExecVP(StrPas(p^),p,EP);
  692. end;
  693. Function WaitPid(Pid:longint;Status:pointer;Options:Integer):Longint;
  694. {
  695. Waits until a child with PID Pid exits, or returns if it is exited already.
  696. Any resources used by the child are freed.
  697. The exit status is reported in the adress referred to by Status. It should
  698. be a longint.
  699. }
  700. var
  701. regs : SysCallregs;
  702. begin
  703. regs.reg2:=pid;
  704. regs.reg3:=longint(status);
  705. regs.reg4:=options;
  706. WaitPid:=SysCall(SysCall_nr_waitpid,regs);
  707. LinuxError:=errno;
  708. end;
  709. Function Shell(Command:String):Longint;
  710. {
  711. Executes the shell, and passes it the string Command. (Through /bin/sh -c)
  712. The current environment is passed to the shell.
  713. It waits for the shell to exit, and returns its exit status.
  714. If the Exec call failed exit status 127 is reported.
  715. }
  716. var
  717. p,pp : ppchar;
  718. sh : string[12];
  719. temp,pid : longint;
  720. begin
  721. sh:='/bin/sh'#0'-c'#0;
  722. Command:=Command+#0;
  723. getmem(pp,12);
  724. if pp=nil then
  725. begin
  726. LinuxError:=Sys_enomem;
  727. exit;
  728. end;
  729. pp^:=@sh[1];
  730. p:=pp+4;
  731. p^:=@sh[9];
  732. p:=p+4;
  733. p^:=@command[1];
  734. pid:=fork;
  735. if pid=-1 then
  736. exit; {Linuxerror already set in Fork}
  737. if pid=0 then
  738. begin
  739. {This is the child.}
  740. Execve('/bin/sh',pp,envp);
  741. exit(127);
  742. end;
  743. temp:=0;
  744. WaitPid(pid,@temp,0);{Linuxerror is set there}
  745. Shell:=temp;{ Return exit status }
  746. end;
  747. Function GetPriority(Which,Who:Integer):integer;
  748. {
  749. Get Priority of process, process group, or user.
  750. Which : selects what kind of priority is used.
  751. can be one of the following predefined Constants :
  752. Prio_User.
  753. Prio_PGrp.
  754. Prio_Process.
  755. Who : depending on which, this is , respectively :
  756. Uid
  757. Pid
  758. Process Group id
  759. Errors are reported in linuxerror _only_. (priority can be negative)
  760. }
  761. var
  762. sr : Syscallregs;
  763. begin
  764. errno:=0;
  765. if (which<prio_process) or (which>prio_user) then
  766. begin
  767. { We can save an interrupt here }
  768. getpriority:=0;
  769. linuxerror:=Sys_einval;
  770. end
  771. else
  772. begin
  773. sr.reg2:=which;
  774. sr.reg3:=who;
  775. getpriority:=SysCall(Syscall_nr_getpriority,sr);
  776. linuxerror:=errno;
  777. end;
  778. end;
  779. Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
  780. {
  781. Set Priority of process, process group, or user.
  782. Which : selects what kind of priority is used.
  783. can be one of the following predefined Constants :
  784. Prio_User.
  785. Prio_PGrp.
  786. Prio_Process.
  787. Who : depending on value of which, this is, respectively :
  788. Uid
  789. Pid
  790. Process Group id
  791. what : A number between -20 and 20. -20 is most favorable, 20 least.
  792. 0 is the default.
  793. }
  794. var
  795. sr : Syscallregs;
  796. begin
  797. errno:=0;
  798. if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
  799. linuxerror:=Sys_einval { We can save an interrupt here }
  800. else
  801. begin
  802. sr.reg2:=which;
  803. sr.reg3:=who;
  804. sr.reg4:=what;
  805. SysCall(Syscall_nr_setpriority,sr);
  806. linuxerror:=errno;
  807. end;
  808. end;
  809. Procedure Nice(N:integer);
  810. {
  811. Set process priority. A positive N means a lower priority.
  812. A negative N decreases priority.
  813. }
  814. var
  815. sr : Syscallregs;
  816. begin
  817. sr.reg2:=n;
  818. SysCall(Syscall_nr_nice,sr);
  819. linuxerror:=errno;
  820. end;
  821. Function GetPid:LongInt;
  822. {
  823. Get Process ID.
  824. }
  825. var
  826. regs : SysCallregs;
  827. begin
  828. GetPid:=SysCall(SysCall_nr_getpid,regs);
  829. linuxerror:=errno;
  830. end;
  831. Function GetPPid:LongInt;
  832. {
  833. Get Process ID of parent process.
  834. }
  835. var
  836. regs : SysCallregs;
  837. begin
  838. GetPpid:=SysCall(SysCall_nr_getppid,regs);
  839. linuxerror:=errno;
  840. end;
  841. Function GetUid:Longint;
  842. {
  843. Get User ID.
  844. }
  845. var
  846. regs : SysCallregs;
  847. begin
  848. GetUid:=SysCall(SysCall_nr_getuid,regs);
  849. Linuxerror:=errno;
  850. end;
  851. Function GetEUid:Longint;
  852. {
  853. Get _effective_ User ID.
  854. }
  855. var
  856. regs : SysCallregs;
  857. begin
  858. GetEuid:=SysCall(SysCall_nr_geteuid,regs);
  859. Linuxerror:=errno;
  860. end;
  861. Function GetGid:Longint;
  862. {
  863. Get Group ID.
  864. }
  865. var
  866. regs : SysCallregs;
  867. begin
  868. Getgid:=SysCall(SysCall_nr_getgid,regs);
  869. Linuxerror:=errno;
  870. end;
  871. Function GetEGid:Longint;
  872. {
  873. Get _effective_ Group ID.
  874. }
  875. var
  876. regs : SysCallregs;
  877. begin
  878. GetEgid:=SysCall(SysCall_nr_getegid,regs);
  879. Linuxerror:=errno;
  880. end;
  881. {******************************************************************************
  882. Date and Time related calls
  883. ******************************************************************************}
  884. Const
  885. {Date Translation}
  886. C1970=2440588;
  887. D0 = 1461;
  888. D1 = 146097;
  889. D2 =1721119;
  890. Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
  891. Var
  892. Century,XYear: LongInt;
  893. Begin
  894. If Month<=2 Then
  895. Begin
  896. Dec(Year);
  897. Inc(Month,12);
  898. End;
  899. Dec(Month,3);
  900. Century:=(longint(Year Div 100)*D1) shr 2;
  901. XYear:=(longint(Year Mod 100)*D0) shr 2;
  902. GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
  903. End;
  904. Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
  905. Var
  906. YYear,XYear,Temp : LongInt;
  907. Begin
  908. Temp:=((JulianDN-D2) shl 2)-1;
  909. JulianDN:=Temp Div D1;
  910. XYear:=(Temp Mod D1) or 3;
  911. YYear:=(XYear Div D0);
  912. Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
  913. Day:=((Temp Mod 153)+5) Div 5;
  914. Month:=Temp Div 153;
  915. If Month>=10 Then
  916. Begin
  917. inc(YYear);
  918. dec(Month,12);
  919. End;
  920. inc(Month,3);
  921. Year:=YYear+(JulianDN*100);
  922. end;
  923. Procedure GetTimeOfDay(var tv:timeval;var tz:timezone);
  924. {
  925. Get the time of day and timezone.
  926. }
  927. var
  928. regs : SysCallregs;
  929. begin
  930. regs.reg2:=longint(@tv);
  931. regs.reg3:=longint(@tz);
  932. SysCall(SysCall_nr_gettimeofday,regs);
  933. LinuxError:=Errno;
  934. end;
  935. Function GetTimeOfDay: longint;
  936. {
  937. Get the number of seconds since 00:00, January 1 1970, GMT
  938. the time NOT corrected any way
  939. }
  940. var
  941. t : timeval ;
  942. tz : timezone ;
  943. begin
  944. gettimeofday(t,tz);{Sets LinuxError also}
  945. GetTimeOfDay:=t.sec;
  946. end;
  947. Function GetEpochTime:longint;
  948. {
  949. Get the number of seconds since 00:00, January 1 1970, GMT
  950. the time is corrected according to the time zone, but NOT
  951. DST corrected.
  952. }
  953. var
  954. t : timeval ;
  955. tz : timezone ;
  956. begin
  957. gettimeofday(t,tz);{Sets LinuxError also}
  958. Getepochtime:=t.sec-tz.minuteswest*60;
  959. end;
  960. Procedure InitEpochToLocal;
  961. var
  962. tv:TimeVal;
  963. begin
  964. GetTimeOfDay(tv,LocalTZ);
  965. end;
  966. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  967. {
  968. Transforms Epoch time(seconds since 00:00, january 1 1970, corrected for
  969. local time zone) into local time (hour, minute,seconds)
  970. }
  971. Var
  972. DateNum: LongInt;
  973. Begin { Beginning of Localtime }
  974. dec(Epoch,LocalTZ.minuteswest*60);
  975. Datenum:=(Epoch Div 86400) + c1970;
  976. JulianToGregorian(DateNum,Year,Month,day);
  977. Epoch:=Epoch Mod 86400;
  978. Hour:=Epoch Div 3600;
  979. Epoch:=Epoch Mod 3600;
  980. Minute:=Epoch Div 60;
  981. Second:=Epoch Mod 60;
  982. End;
  983. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  984. {
  985. Transforms local time (year,month,day,hour,minutes,second) to Epoch time
  986. (seconds since 00:00, january 1 1970, corrected for local time zone)
  987. }
  988. Begin
  989. LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
  990. (LongInt(Hour)*3600)+(Minute*60)+Second+(LocalTZ.minuteswest*60);
  991. End;
  992. Procedure GetTime(Var Hour,Minute,Second:Word);
  993. {
  994. Gets the current time, adjusted to local time, but not DST,
  995. in hours, minutes and seconds.
  996. }
  997. var
  998. year,day,month:Word;
  999. Begin
  1000. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  1001. End;
  1002. Procedure GetDate(Var Year,Month,Day:Word);
  1003. {
  1004. Gets the current date, adjusted to local time, but not DST,
  1005. in year,month,day.
  1006. }
  1007. var
  1008. hour,minute,second : Word;
  1009. Begin
  1010. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  1011. End;
  1012. { The now following are for compatibility with earlier versions
  1013. of the linux unit... }
  1014. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Integer);
  1015. begin
  1016. EpochToLocal(epoch,word(year),word(month),word(day),word(hour),word(minute),word(second));
  1017. end;
  1018. Function LocalToEpoch(year,month,day,hour,minute,second:Integer):Longint;
  1019. begin
  1020. LocalToEpoch:=LocalToEpoch(word(year),word(month),word(day),word(hour),word(minute),word(second));
  1021. end;
  1022. Procedure GetTime(Var Hour,Minute,Second:Integer);
  1023. begin
  1024. GetTime(Word(Hour),Word(Minute),Word(Second));
  1025. end;
  1026. Procedure GetDate(Var Year,Month,Day:Integer);
  1027. begin
  1028. GetDate(Word(Year),Word(Month),Word(Day));
  1029. end;
  1030. {******************************************************************************
  1031. FileSystem calls
  1032. ******************************************************************************}
  1033. Function fdOpen(pathname:string;flags:longint):longint;
  1034. begin
  1035. pathname:=pathname+#0;
  1036. fdOpen:=Sys_Open(@pathname[1],flags,0);
  1037. LinuxError:=Errno;
  1038. end;
  1039. Function fdOpen(pathname:string;flags,mode:longint):longint;
  1040. begin
  1041. pathname:=pathname+#0;
  1042. fdOpen:=Sys_Open(@pathname[1],flags,mode);
  1043. LinuxError:=Errno;
  1044. end;
  1045. Function fdOpen(pathname:pchar;flags:longint):longint;
  1046. begin
  1047. fdOpen:=Sys_Open(pathname,flags,0);
  1048. LinuxError:=Errno;
  1049. end;
  1050. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  1051. begin
  1052. fdOpen:=Sys_Open(pathname,flags,mode);
  1053. LinuxError:=Errno;
  1054. end;
  1055. Function fdClose(fd:longint):boolean;
  1056. begin
  1057. fdClose:=(Sys_Close(fd)=0);
  1058. LinuxError:=Errno;
  1059. end;
  1060. Function fdRead(fd:longint;var buf;size:longint):longint;
  1061. begin
  1062. fdRead:=Sys_Read(fd,pchar(@buf),size);
  1063. LinuxError:=Errno;
  1064. end;
  1065. Function fdWrite(fd:longint;var buf;size:longint):longint;
  1066. begin
  1067. fdWrite:=Sys_Write(fd,pchar(@buf),size);
  1068. LinuxError:=Errno;
  1069. end;
  1070. Function fdTruncate(fd,size:longint):boolean;
  1071. var
  1072. Regs : SysCallRegs;
  1073. begin
  1074. Regs.reg2:=fd;
  1075. Regs.reg3:=size;
  1076. fdTruncate:=(SysCall(Syscall_nr_ftruncate,regs)=0);
  1077. LinuxError:=Errno;
  1078. end;
  1079. Function fdSeek (fd,pos,seektype :longint): longint;
  1080. {
  1081. Do a Seek on a file descriptor fd to position pos, starting from seektype
  1082. }
  1083. begin
  1084. fdseek:=Sys_LSeek (fd,pos,seektype);
  1085. LinuxError:=Errno;
  1086. end;
  1087. Function fdFlush (fd : Longint) : Boolean;
  1088. var
  1089. SR: SysCallRegs;
  1090. begin
  1091. SR.reg2 := fd;
  1092. fdFlush := (SysCall(syscall_nr_fsync, SR)=0);
  1093. LinuxError:=Errno;
  1094. end;
  1095. Function Fcntl(Fd:Text;Cmd:integer):integer;
  1096. {
  1097. Read or manipulate a file.(See also fcntl (2) )
  1098. Possible values for Cmd are :
  1099. F_GetFd,F_GetFl,F_GetOwn
  1100. Errors are reported in Linuxerror;
  1101. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  1102. }
  1103. var
  1104. sr : Syscallregs;
  1105. begin
  1106. if (cmd in [F_GetFd,F_GetFl,F_GetOwn]) then
  1107. begin
  1108. sr.reg2:=textrec(fd).handle;
  1109. sr.reg3:=cmd;
  1110. Linuxerror:=SysCall(Syscall_nr_fcntl,sr);
  1111. if linuxerror=-1 then
  1112. begin
  1113. linuxerror:=errno;
  1114. fcntl:=0;
  1115. end
  1116. else
  1117. begin
  1118. fcntl:=linuxerror;
  1119. linuxerror:=0;
  1120. end;
  1121. end
  1122. else
  1123. begin
  1124. linuxerror:=Sys_einval;
  1125. Fcntl:=0;
  1126. end;
  1127. end;
  1128. Procedure Fcntl(Fd:Text;Cmd:Integer;Arg:Longint);
  1129. {
  1130. Read or manipulate a file. (See also fcntl (2) )
  1131. Possible values for Cmd are :
  1132. F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
  1133. Errors are reported in Linuxerror;
  1134. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  1135. F_DupFD is not allowed, due to the structure of Files in Pascal.
  1136. }
  1137. var
  1138. sr : Syscallregs;
  1139. begin
  1140. if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn]) then
  1141. begin
  1142. sr.reg2:=textrec(fd).handle;
  1143. sr.reg3:=cmd;
  1144. sr.reg4:=arg;
  1145. SysCall(Syscall_nr_fcntl,sr);
  1146. linuxerror:=errno;
  1147. end
  1148. else
  1149. linuxerror:=Sys_einval;
  1150. end;
  1151. Function Chmod(path:pathstr;Newmode:longint):Boolean;
  1152. {
  1153. Changes the permissions of a file.
  1154. }
  1155. var
  1156. sr : Syscallregs;
  1157. begin
  1158. path:=path+#0;
  1159. sr.reg2:=longint(@(path[1]));
  1160. sr.reg3:=newmode;
  1161. Chmod:=(SysCall(Syscall_nr_chmod,sr)=0);
  1162. linuxerror:=errno;
  1163. end;
  1164. Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
  1165. {
  1166. Change the owner and group of a file.
  1167. A user can only change the group to a group of which he is a member.
  1168. The super-user can change uid and gid of any file.
  1169. }
  1170. var
  1171. sr : Syscallregs;
  1172. begin
  1173. path:=path+#0;
  1174. sr.reg2:=longint(@(path[1]));
  1175. sr.reg3:=newuid;
  1176. sr.reg4:=newgid;
  1177. ChOwn:=(Syscall(Syscall_nr_chown,sr)=0);
  1178. linuxerror:=errno;
  1179. end;
  1180. Function Utime(path:pathstr;utim:utimbuf):boolean;
  1181. var
  1182. sr : Syscallregs;
  1183. begin
  1184. path:=path+#0;
  1185. sr.reg2:=longint(@(path[1]));
  1186. sr.reg3:=longint(@utim);
  1187. Utime:=SysCall(Syscall_nr_utime,sr)=0;
  1188. linuxerror:=errno;
  1189. end;
  1190. Function Flock (fd,mode : longint) : boolean;
  1191. var sr : Syscallregs;
  1192. begin
  1193. sr.reg2:=fd;
  1194. sr.reg3:=mode;
  1195. flock:=Syscall(Syscall_nr_flock,sr)=0;
  1196. LinuxError:=errno;
  1197. end;
  1198. Function Flock (var T : text;mode : longint) : boolean;
  1199. begin
  1200. Flock:=Flock( TextRec(T).Handle,mode );
  1201. end;
  1202. Function Flock (var F : File;mode : longint) : boolean;
  1203. begin
  1204. Flock:=Flock(FileRec(F).Handle,mode);
  1205. end;
  1206. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  1207. {
  1208. Get all information on a file, and return it in Info.
  1209. }
  1210. begin
  1211. path:=path+#0;
  1212. FStat:=(Sys_stat(@(path[1]),Info)=0);
  1213. LinuxError:=errno;
  1214. end;
  1215. Function Fstat(Fd:Longint;var Info:stat):Boolean;
  1216. {
  1217. Get all information on a file descriptor, and return it in info.
  1218. }
  1219. var
  1220. regs : SysCallregs;
  1221. begin
  1222. regs.reg2:=Fd;
  1223. regs.reg3:=longint(@Info);
  1224. FStat:=(SysCall(SysCall_nr_fstat,regs)=0);
  1225. LinuxError:=Errno;
  1226. end;
  1227. Function FStat(var F:Text;Var Info:stat):Boolean;
  1228. {
  1229. Get all information on a text file, and return it in info.
  1230. }
  1231. begin
  1232. FStat:=Fstat(TextRec(F).Handle,INfo);
  1233. end;
  1234. Function FStat(var F:File;Var Info:stat):Boolean;
  1235. {
  1236. Get all information on a untyped file, and return it in info.
  1237. }
  1238. begin
  1239. FStat:=Fstat(FileRec(F).Handle,Info);
  1240. end;
  1241. Function Lstat(Filename: PathStr;var Info:stat):Boolean;
  1242. {
  1243. Get all information on a link (the link itself), and return it in info.
  1244. }
  1245. var
  1246. regs : SysCallregs;
  1247. begin
  1248. FileName:=FileName+#0;
  1249. regs.reg2:=longint(@filename[1]);
  1250. regs.reg3:=longint(@Info);
  1251. LStat:=(SysCall(SysCall_nr_lstat,regs)=0);
  1252. LinuxError:=Errno;
  1253. end;
  1254. Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
  1255. {
  1256. Get all information on a fileSystem, and return it in Info.
  1257. Path is the name of a file/directory on the fileSystem you wish to
  1258. investigate.
  1259. }
  1260. var
  1261. regs : SysCallregs;
  1262. begin
  1263. path:=path+#0;
  1264. regs.reg2:=longint(@path[1]);
  1265. regs.reg3:=longint(@Info);
  1266. FSStat:=(SysCall(SysCall_nr_statfs,regs)=0);
  1267. LinuxError:=errno;
  1268. end;
  1269. Function FSStat(Fd:Longint;Var Info:statfs):Boolean;
  1270. {
  1271. Get all information on a fileSystem, and return it in Info.
  1272. Fd is the file descriptor of a file/directory on the fileSystem
  1273. you wish to investigate.
  1274. }
  1275. var
  1276. regs : SysCallregs;
  1277. begin
  1278. regs.reg2:=Fd;
  1279. regs.reg3:=longint(@Info);
  1280. FSStat:=(SysCall(SysCall_nr_fstatfs,regs)=0);
  1281. LinuxError:=errno;
  1282. end;
  1283. Function Link(OldPath,NewPath:pathstr):boolean;
  1284. {
  1285. Proceduces a hard link from new to old.
  1286. In effect, new will be the same file as old.
  1287. }
  1288. var
  1289. regs : SysCallregs;
  1290. begin
  1291. oldpath:=oldpath+#0;
  1292. newpath:=newpath+#0;
  1293. regs.reg2:=longint(@oldpath[1]);
  1294. regs.reg3:=longint(@newpath[1]);
  1295. Link:=SysCall(SysCall_nr_link,regs)=0;
  1296. linuxerror:=errno;
  1297. end;
  1298. Function SymLink(OldPath,newPath:pathstr):boolean;
  1299. {
  1300. Proceduces a soft link from new to old.
  1301. }
  1302. begin
  1303. oldpath:=oldpath+#0;
  1304. newpath:=newpath+#0;
  1305. Symlink:=Sys_symlink(pchar(@(oldpath[1])),pchar(@(newpath[1])))=0;
  1306. linuxerror:=errno;
  1307. end;
  1308. Function UnLink(Path:pathstr):boolean;
  1309. {
  1310. Removes the file in 'Path' (that is, it decreases the link count with one.
  1311. if the link count is zero, the file is removed from the disk.
  1312. }
  1313. begin
  1314. path:=path+#0;
  1315. Unlink:=Sys_unlink(pchar(@(path[1])))=0;
  1316. linuxerror:=errno;
  1317. end;
  1318. Function UnLink(Path:pchar):Boolean;
  1319. {
  1320. Removes the file in 'Path' (that is, it decreases the link count with one.
  1321. if the link count is zero, the file is removed from the disk.
  1322. }
  1323. begin
  1324. Unlink:=(Sys_unlink(path)=0);
  1325. linuxerror:=errno;
  1326. end;
  1327. Function Umask(Mask:Integer):integer;
  1328. {
  1329. Sets file creation mask to (Mask and 0777 (octal) ), and returns the
  1330. previous value.
  1331. }
  1332. var
  1333. sr : Syscallregs;
  1334. begin
  1335. sr.reg2:=mask;
  1336. Umask:=SysCall(Syscall_nr_umask,sr);
  1337. linuxerror:=0;
  1338. end;
  1339. Function Access(Path:Pathstr ;mode:integer):boolean;
  1340. {
  1341. Test users access rights on the specified file.
  1342. Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
  1343. R,W,X stand for read,write and Execute access, simultaneously.
  1344. F_OK checks whether the test would be allowed on the file.
  1345. i.e. It checks the search permissions in all directory components
  1346. of the path.
  1347. The test is done with the real user-ID, instead of the effective.
  1348. If access is denied, or an error occurred, false is returned.
  1349. If access is granted, true is returned.
  1350. Errors other than no access,are reported in linuxerror.
  1351. }
  1352. var
  1353. sr : Syscallregs;
  1354. begin
  1355. path:=path+#0;
  1356. sr.reg2:=longint(@(path[1]));
  1357. sr.reg3:=mode;
  1358. access:=(SysCall(Syscall_nr_access,sr)=0);
  1359. linuxerror:=errno;
  1360. end;
  1361. Function Dup(oldfile,newfile:longint):Boolean;
  1362. {
  1363. Copies the filedescriptor oldfile to newfile
  1364. }
  1365. var
  1366. sr : Syscallregs;
  1367. begin
  1368. sr.reg2:=oldfile;
  1369. newfile:=Syscall(Syscall_nr_dup,sr);
  1370. linuxerror:=errno;
  1371. Dup:=(LinuxError=0);
  1372. end;
  1373. Function Dup(var oldfile,newfile:text):Boolean;
  1374. {
  1375. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  1376. oldfile.
  1377. After which the two textfiles are, in effect, the same, except
  1378. that they don't share the same buffer, and don't share the same
  1379. close_on_exit flag.
  1380. }
  1381. begin
  1382. flush(oldfile);{ We cannot share buffers, so we flush them. }
  1383. textrec(newfile):=textrec(oldfile);
  1384. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  1385. Dup:=Dup(textrec(oldfile).handle,textrec(newfile).handle);
  1386. end;
  1387. Function Dup(var oldfile,newfile:file):Boolean;
  1388. {
  1389. Copies the filedescriptor oldfile to newfile
  1390. }
  1391. begin
  1392. filerec(newfile):=filerec(oldfile);
  1393. Dup:=Dup(filerec(oldfile).handle,filerec(newfile).handle);
  1394. end;
  1395. Function Dup2(oldfile,newfile:longint):Boolean;
  1396. {
  1397. Copies the filedescriptor oldfile to newfile
  1398. }
  1399. var
  1400. sr : Syscallregs;
  1401. begin
  1402. sr.reg2:=oldfile;
  1403. sr.reg3:=newfile;
  1404. SysCall(Syscall_nr_dup2,sr);
  1405. linuxerror:=errno;
  1406. Dup2:=(LinuxError=0);
  1407. end;
  1408. Function Dup2(var oldfile,newfile:text):Boolean;
  1409. {
  1410. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  1411. oldfile. It closes newfile if it was still open.
  1412. After which the two textfiles are, in effect, the same, except
  1413. that they don't share the same buffer, and don't share the same
  1414. close_on_exit flag.
  1415. }
  1416. var
  1417. tmphandle : word;
  1418. begin
  1419. flush(oldfile);{ We cannot share buffers, so we flush them. }
  1420. flush(newfile);
  1421. tmphandle:=textrec(newfile).handle;
  1422. textrec(newfile):=textrec(oldfile);
  1423. textrec(newfile).handle:=tmphandle;
  1424. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  1425. Dup2:=Dup2(textrec(oldfile).handle,textrec(newfile).handle);
  1426. end;
  1427. Function Dup2(var oldfile,newfile:file):Boolean;
  1428. {
  1429. Copies the filedescriptor oldfile to newfile
  1430. }
  1431. begin
  1432. filerec(newfile):=filerec(oldfile);
  1433. Dup2:=Dup2(filerec(oldfile).handle,filerec(newfile).handle);
  1434. end;
  1435. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
  1436. {
  1437. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  1438. have changed.
  1439. }
  1440. Var
  1441. SelectArray : Array[1..5] of longint;
  1442. Sr : Syscallregs;
  1443. begin
  1444. SelectArray[1]:=n;
  1445. SelectArray[2]:=longint(Readfds);
  1446. Selectarray[3]:=longint(Writefds);
  1447. selectarray[4]:=longint(exceptfds);
  1448. Selectarray[5]:=longint(TimeOut);
  1449. sr.reg2:=longint(@selectarray);
  1450. Select:=SysCall(Syscall_nr_select,sr);
  1451. LinuxError:=Errno;
  1452. end;
  1453. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  1454. {
  1455. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  1456. have changed.
  1457. This function allows specification of a timeout as a longint.
  1458. }
  1459. var
  1460. p : PTimeVal;
  1461. tv : TimeVal;
  1462. begin
  1463. if TimeOut=-1 then
  1464. p:=nil
  1465. else
  1466. begin
  1467. tv.Sec:=Timeout div 1000;
  1468. tv.Usec:=(Timeout mod 1000)*1000;
  1469. p:=@tv;
  1470. end;
  1471. Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
  1472. end;
  1473. Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
  1474. Var
  1475. F:FDSet;
  1476. begin
  1477. if textrec(t).mode=fmclosed then
  1478. begin
  1479. LinuxError:=Sys_EBADF;
  1480. exit(-1);
  1481. end;
  1482. FD_Zero(f);
  1483. FD_Set(textrec(T).handle,f);
  1484. if textrec(T).mode=fminput then
  1485. SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
  1486. else
  1487. SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
  1488. end;
  1489. {******************************************************************************
  1490. Directory
  1491. ******************************************************************************}
  1492. Function OpenDir(F:String):PDir;
  1493. begin
  1494. F:=F+#0;
  1495. OpenDir:=OpenDir(@F[1]);
  1496. end;
  1497. procedure SeekDir(p:pdir;off:longint);
  1498. begin
  1499. if p=nil then
  1500. begin
  1501. errno:=Sys_EBADF;
  1502. exit;
  1503. end;
  1504. p^.nextoff:=Sys_lseek(p^.fd,off,seek_set);
  1505. p^.size:=0;
  1506. p^.loc:=0;
  1507. end;
  1508. function TellDir(p:pdir):longint;
  1509. begin
  1510. if p=nil then
  1511. begin
  1512. errno:=Sys_EBADF;
  1513. telldir:=-1;
  1514. exit;
  1515. end;
  1516. telldir:=Sys_lseek(p^.fd,0,seek_cur)
  1517. { We could try to use the nextoff field here, but on my 1.2.13
  1518. kernel, this gives nothing... This may have to do with
  1519. the readdir implementation of libc... I also didn't find any trace of
  1520. the field in the kernel code itself, So I suspect it is an artifact of libc.
  1521. Michael. }
  1522. end;
  1523. Function ReadDir(P:pdir):pdirent;
  1524. begin
  1525. ReadDir:=Sys_ReadDir(p);
  1526. LinuxError:=Errno;
  1527. end;
  1528. {******************************************************************************
  1529. Pipes/Fifo
  1530. ******************************************************************************}
  1531. Procedure OpenPipe(var F:Text);
  1532. begin
  1533. case textrec(f).mode of
  1534. fmoutput : if textrec(f).userdata[1]<>P_OUT then
  1535. textrec(f).mode:=fmclosed;
  1536. fminput : if textrec(f).userdata[1]<>P_IN then
  1537. textrec(f).mode:=fmclosed;
  1538. else
  1539. textrec(f).mode:=fmclosed;
  1540. end;
  1541. end;
  1542. Procedure IOPipe(var F:text);
  1543. begin
  1544. case textrec(f).mode of
  1545. fmoutput : Sys_write(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
  1546. fminput : textrec(f).bufend:=Sys_read(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
  1547. end;
  1548. textrec(f).bufpos:=0;
  1549. end;
  1550. Procedure FlushPipe(var F:Text);
  1551. begin
  1552. if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
  1553. IOPipe(f);
  1554. textrec(f).bufpos:=0;
  1555. end;
  1556. Procedure ClosePipe(var F:text);
  1557. begin
  1558. textrec(f).mode:=fmclosed;
  1559. Sys_close(textrec(f).handle);
  1560. end;
  1561. Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
  1562. {
  1563. Sets up a pair of file variables, which act as a pipe. The first one can
  1564. be read from, the second one can be written to.
  1565. If the operation was unsuccesful, linuxerror is set.
  1566. }
  1567. var
  1568. pip : tpipe;
  1569. regs : SysCallregs;
  1570. begin
  1571. regs.reg2:=longint(@pip);
  1572. SysCall(SysCall_nr_pipe,regs);
  1573. pipe_in:=pip[1];
  1574. pipe_out:=pip[2];
  1575. linuxerror:=errno;
  1576. AssignPipe:=(LinuxError=0);
  1577. end;
  1578. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  1579. {
  1580. Sets up a pair of file variables, which act as a pipe. The first one can
  1581. be read from, the second one can be written to.
  1582. If the operation was unsuccesful, linuxerror is set.
  1583. }
  1584. var
  1585. f_in,f_out : longint;
  1586. begin
  1587. if not AssignPipe(f_in,f_out) then
  1588. begin
  1589. AssignPipe:=false;
  1590. exit;
  1591. end;
  1592. { Set up input }
  1593. Assign(Pipe_in,'.');
  1594. Textrec(Pipe_in).Handle:=f_in;
  1595. Textrec(Pipe_in).Mode:=fmInput;
  1596. Textrec(Pipe_in).userdata[1]:=P_IN;
  1597. TextRec(Pipe_in).OpenFunc:=@OpenPipe;
  1598. TextRec(Pipe_in).InOutFunc:=@IOPipe;
  1599. TextRec(Pipe_in).FlushFunc:=@FlushPipe;
  1600. TextRec(Pipe_in).CloseFunc:=@ClosePipe;
  1601. { Set up output }
  1602. Assign(Pipe_out,'.');
  1603. Textrec(Pipe_out).Handle:=f_out;
  1604. Textrec(Pipe_out).Mode:=fmOutput;
  1605. Textrec(Pipe_out).userdata[1]:=P_OUT;
  1606. TextRec(Pipe_out).OpenFunc:=@OpenPipe;
  1607. TextRec(Pipe_out).InOutFunc:=@IOPipe;
  1608. TextRec(Pipe_out).FlushFunc:=@FlushPipe;
  1609. TextRec(Pipe_out).CloseFunc:=@ClosePipe;
  1610. AssignPipe:=true;
  1611. end;
  1612. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  1613. {
  1614. Sets up a pair of file variables, which act as a pipe. The first one can
  1615. be read from, the second one can be written to.
  1616. If the operation was unsuccesful, linuxerror is set.
  1617. }
  1618. var
  1619. f_in,f_out : longint;
  1620. begin
  1621. if not AssignPipe(f_in,f_out) then
  1622. begin
  1623. AssignPipe:=false;
  1624. exit;
  1625. end;
  1626. { Set up input }
  1627. Assign(Pipe_in,'.');
  1628. Filerec(Pipe_in).Handle:=f_in;
  1629. Filerec(Pipe_in).Mode:=fmInput;
  1630. Filerec(Pipe_in).recsize:=1;
  1631. Filerec(Pipe_in).userdata[1]:=P_IN;
  1632. { Set up output }
  1633. Assign(Pipe_out,'.');
  1634. Filerec(Pipe_out).Handle:=f_out;
  1635. Filerec(Pipe_out).Mode:=fmoutput;
  1636. Filerec(Pipe_out).recsize:=1;
  1637. Filerec(Pipe_out).userdata[1]:=P_OUT;
  1638. AssignPipe:=true;
  1639. end;
  1640. Function PClose(Var F:text) :longint;
  1641. var
  1642. sr : syscallregs;
  1643. pl : ^longint;
  1644. res : longint;
  1645. begin
  1646. sr.reg2:=Textrec(F).Handle;
  1647. SysCall (syscall_nr_close,sr);
  1648. { closed our side, Now wait for the other - this appears to be needed ?? }
  1649. pl:=@(textrec(f).userdata[2]);
  1650. waitpid(pl^,@res,0);
  1651. pclose:=res shr 8;
  1652. end;
  1653. Function PClose(Var F:file) : longint;
  1654. var
  1655. sr : syscallregs;
  1656. pl : ^longint;
  1657. res : longint;
  1658. begin
  1659. sr.reg2:=FileRec(F).Handle;
  1660. SysCall (Syscall_nr_close,sr);
  1661. { closed our side, Now wait for the other - this appears to be needed ?? }
  1662. pl:=@(filerec(f).userdata[2]);
  1663. waitpid(pl^,@res,0);
  1664. pclose:=res shr 8;
  1665. end;
  1666. Procedure PCloseText(Var F:text);
  1667. {
  1668. May not use @PClose due overloading
  1669. }
  1670. begin
  1671. PClose(f);
  1672. end;
  1673. Procedure POpen(var F:text;const Prog:String;rw:char);
  1674. {
  1675. Starts the program in 'Prog' and makes it's input or out put the
  1676. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  1677. F, will be read from stdin by the program in 'Prog'. The inverse is true
  1678. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  1679. read from 'f'.
  1680. }
  1681. var
  1682. pipi,
  1683. pipo : text;
  1684. pid : longint;
  1685. pl : ^longint;
  1686. p,pp : ppchar;
  1687. temp : string[255];
  1688. begin
  1689. LinuxError:=0;
  1690. rw:=upcase(rw);
  1691. if not (rw in ['R','W']) then
  1692. begin
  1693. LinuxError:=Sys_enoent;
  1694. exit;
  1695. end;
  1696. AssignPipe(pipi,pipo);
  1697. if Linuxerror<>0 then
  1698. exit;
  1699. pid:=fork;
  1700. if linuxerror<>0 then
  1701. begin
  1702. close(pipi);
  1703. close(pipo);
  1704. exit;
  1705. end;
  1706. if pid=0 then
  1707. begin
  1708. { We're in the child }
  1709. if rw='W' then
  1710. begin
  1711. close(pipo);
  1712. dup2(pipi,input);
  1713. close(pipi);
  1714. if linuxerror<>0 then
  1715. halt(127);
  1716. end
  1717. else
  1718. begin
  1719. close(pipi);
  1720. dup2(pipo,output);
  1721. close(pipo);
  1722. if linuxerror<>0 then
  1723. halt(127);
  1724. end;
  1725. getmem(pp,sizeof(pchar)*4);
  1726. temp:='/bin/sh'#0'-c'#0+prog+#0;
  1727. pp^:=@temp[1];
  1728. p:=pp+sizeof(pchar);
  1729. p^:=@temp[9];
  1730. p:=p+sizeof(pchar);
  1731. p^:=@temp[12];
  1732. p:=p+sizeof(pchar);
  1733. p^:=Nil;
  1734. Execve('/bin/sh',pp,envp);
  1735. halt(127);
  1736. end
  1737. else
  1738. begin
  1739. { We're in the parent }
  1740. if rw='W' then
  1741. begin
  1742. close(pipi);
  1743. f:=pipo;
  1744. textrec(f).bufptr:=@textrec(f).buffer;
  1745. end
  1746. else
  1747. begin
  1748. close(pipo);
  1749. f:=pipi;
  1750. textrec(f).bufptr:=@textrec(f).buffer;
  1751. end;
  1752. {Save the process ID - needed when closing }
  1753. pl:=@(textrec(f).userdata[2]);
  1754. pl^:=pid;
  1755. textrec(f).closefunc:=@PCloseText;
  1756. end;
  1757. end;
  1758. Procedure POpen(var F:file;const Prog:String;rw:char);
  1759. {
  1760. Starts the program in 'Prog' and makes it's input or out put the
  1761. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  1762. F, will be read from stdin by the program in 'Prog'. The inverse is true
  1763. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  1764. read from 'f'.
  1765. }
  1766. var
  1767. pipi,
  1768. pipo : file;
  1769. pid : longint;
  1770. pl : ^longint;
  1771. p,pp : ppchar;
  1772. temp : string[255];
  1773. begin
  1774. LinuxError:=0;
  1775. rw:=upcase(rw);
  1776. if not (rw in ['R','W']) then
  1777. begin
  1778. LinuxError:=Sys_enoent;
  1779. exit;
  1780. end;
  1781. AssignPipe(pipi,pipo);
  1782. if Linuxerror<>0 then
  1783. exit;
  1784. pid:=fork;
  1785. if linuxerror<>0 then
  1786. begin
  1787. close(pipi);
  1788. close(pipo);
  1789. exit;
  1790. end;
  1791. if pid=0 then
  1792. begin
  1793. { We're in the child }
  1794. if rw='W' then
  1795. begin
  1796. close(pipo);
  1797. dup2(filerec(pipi).handle,stdinputhandle);
  1798. close(pipi);
  1799. if linuxerror<>0 then
  1800. halt(127);
  1801. end
  1802. else
  1803. begin
  1804. close(pipi);
  1805. dup2(filerec(pipo).handle,stdoutputhandle);
  1806. close(pipo);
  1807. if linuxerror<>0 then
  1808. halt(127);
  1809. end;
  1810. getmem(pp,sizeof(pchar)*4);
  1811. temp:='/bin/sh'#0'-c'#0+prog+#0;
  1812. pp^:=@temp[1];
  1813. p:=pp+sizeof(pchar);
  1814. p^:=@temp[9];
  1815. p:=p+sizeof(pchar);
  1816. p^:=@temp[12];
  1817. p:=p+sizeof(pchar);
  1818. p^:=Nil;
  1819. Execve('/bin/sh',pp,envp);
  1820. halt(127);
  1821. end
  1822. else
  1823. begin
  1824. { We're in the parent }
  1825. if rw='W' then
  1826. begin
  1827. close(pipi);
  1828. f:=pipo;
  1829. end
  1830. else
  1831. begin
  1832. close(pipo);
  1833. f:=pipi;
  1834. end;
  1835. {Save the process ID - needed when closing }
  1836. pl:=@(filerec(f).userdata[2]);
  1837. pl^:=pid;
  1838. end;
  1839. end;
  1840. Function mkFifo(pathname:string;mode:longint):boolean;
  1841. var
  1842. regs : SysCallRegs;
  1843. begin
  1844. pathname:=pathname+#0;
  1845. regs.reg2:=longint(@pathname[1]);
  1846. regs.reg3:=mode or STAT_IFIFO;
  1847. regs.reg4:=0;
  1848. mkFifo:=(SysCall(syscall_nr_mknod,regs)=0);
  1849. end;
  1850. Procedure AssignStream(Var StreamIn,Streamout:text;Const Prog:String);
  1851. {
  1852. Starts the program in 'Prog' and makes its input and output the
  1853. other end of two pipes, which are the stdin and stdout of a program
  1854. specified in 'Prog'.
  1855. streamout can be used to write to the program, streamin can be used to read
  1856. the output of the program. See the following diagram :
  1857. Parent Child
  1858. STreamout --> Input
  1859. Streamin <-- Output
  1860. }
  1861. var
  1862. pipi,
  1863. pipo : text;
  1864. pid : longint;
  1865. begin
  1866. LinuxError:=0;
  1867. AssignPipe(streamin,pipo);
  1868. if Linuxerror<>0 then
  1869. exit;
  1870. AssignPipe(pipi,streamout);
  1871. if Linuxerror<>0 then
  1872. exit;
  1873. pid:=fork;
  1874. if linuxerror<>0 then
  1875. begin
  1876. close(pipi);
  1877. close(pipo);
  1878. close (streamin);
  1879. close (streamout);
  1880. exit;
  1881. end;
  1882. if pid=0 then
  1883. begin
  1884. { We're in the child }
  1885. { Close what we don't need }
  1886. close(streamout);
  1887. close(streamin);
  1888. dup2(pipi,input);
  1889. if linuxerror<>0 then
  1890. halt(127);
  1891. close(pipi);
  1892. dup2(pipo,output);
  1893. if linuxerror<>0 then
  1894. halt (127);
  1895. close(pipo);
  1896. Execl(Prog);
  1897. halt(127);
  1898. end
  1899. else
  1900. begin
  1901. { we're in the parent}
  1902. {
  1903. Let's redraw the schedule :
  1904. Parent Child
  1905. pipo[1] --> pipi[1]
  1906. pipi[0] <-- pipo[0]
  1907. }
  1908. close(pipo);
  1909. // dup(pipi[0],streamin);
  1910. // close (pipi[0]);
  1911. close(pipi);
  1912. // dup(pipo[1],streamout);
  1913. // close (pipo[1]);
  1914. end;
  1915. end;
  1916. {******************************************************************************
  1917. General information calls
  1918. ******************************************************************************}
  1919. Function Sysinfo(var Info:TSysinfo):Boolean;
  1920. {
  1921. Get system info
  1922. }
  1923. var
  1924. regs : SysCallregs;
  1925. Begin
  1926. regs.reg2:=longint(@info);
  1927. Sysinfo:=SysCall(SysCall_nr_Sysinfo,regs)=0;
  1928. End;
  1929. Function Uname(var unamerec:utsname):Boolean;
  1930. {
  1931. Get machine's names
  1932. }
  1933. var
  1934. regs : SysCallregs;
  1935. Begin
  1936. regs.reg2:=longint(@unamerec);
  1937. Uname:=SysCall(SysCall_nr_uname,regs)=0;
  1938. LinuxError:=Errno;
  1939. End;
  1940. Function GetEnv(P:string):Pchar;
  1941. {
  1942. Searches the environment for a string with name p and
  1943. returns a pchar to it's value.
  1944. A pchar is used to accomodate for strings of length > 255
  1945. }
  1946. var
  1947. ep : ppchar;
  1948. found : boolean;
  1949. Begin
  1950. p:=p+'='; {Else HOST will also find HOSTNAME, etc}
  1951. ep:=envp;
  1952. found:=false;
  1953. while (not found) and (ep^<>nil) do
  1954. begin
  1955. if strlcomp(@p[1],(ep^),length(p))=0 then
  1956. found:=true
  1957. else
  1958. ep:=ep+4;
  1959. end;
  1960. if found then
  1961. getenv:=ep^+length(p)
  1962. else
  1963. getenv:=nil;
  1964. end;
  1965. Function GetDomainName:String;
  1966. {
  1967. Get machines domain name. Returns empty string if not set.
  1968. }
  1969. Var
  1970. Sysn : utsname;
  1971. begin
  1972. Uname(Sysn);
  1973. linuxerror:=errno;
  1974. If linuxerror<>0 then
  1975. getdomainname:=''
  1976. else
  1977. getdomainname:=strpas(@Sysn.domainname[0]);
  1978. end;
  1979. Function GetHostName:String;
  1980. {
  1981. Get machines name. Returns empty string if not set.
  1982. }
  1983. Var
  1984. Sysn : utsname;
  1985. begin
  1986. uname(Sysn);
  1987. linuxerror:=errno;
  1988. If linuxerror<>0 then
  1989. gethostname:=''
  1990. else
  1991. gethostname:=strpas(@Sysn.nodename[0]);
  1992. end;
  1993. {******************************************************************************
  1994. Signal handling calls
  1995. ******************************************************************************}
  1996. Function Kill(Pid:longint;Sig:integer):integer;
  1997. {
  1998. Send signal 'sig' to a process, or a group of processes.
  1999. If Pid > 0 then the signal is sent to pid
  2000. pid=-1 to all processes except process 1
  2001. pid < -1 to process group -pid
  2002. Return value is zero, except for case three, where the return value
  2003. is the number of processes to which the signal was sent.
  2004. }
  2005. var
  2006. regs : Syscallregs;
  2007. begin
  2008. regs.reg2:=Pid;
  2009. regs.reg3:=Sig;
  2010. kill:=SysCall(Syscall_nr_kill,regs);
  2011. if kill<0 then
  2012. Kill:=0;
  2013. linuxerror:=errno;
  2014. end;
  2015. Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
  2016. {
  2017. Change action of process upon receipt of a signal.
  2018. Signum specifies the signal (all except SigKill and SigStop).
  2019. If Act is non-nil, it is used to specify the new action.
  2020. If OldAct is non-nil the previous action is saved there.
  2021. }
  2022. Var
  2023. sr : Syscallregs;
  2024. begin
  2025. sr.reg2:=Signum;
  2026. sr.reg3:=Longint(act);
  2027. sr.reg4:=Longint(oldact);
  2028. SysCall(Syscall_nr_sigaction,sr);
  2029. linuxerror:=errno;
  2030. end;
  2031. Procedure SigProcMask(How:Integer;SSet,OldSSet:PSigSet);
  2032. {
  2033. Change the list of currently blocked signals.
  2034. How determines which signals will be blocked :
  2035. SigBlock : Add SSet to the current list of blocked signals
  2036. SigUnBlock : Remove the signals in SSet from the list of blocked signals.
  2037. SigSetMask : Set the list of blocked signals to SSet
  2038. if OldSSet is non-null, the old set will be saved there.
  2039. }
  2040. Var
  2041. sr : SyscallRegs;
  2042. begin
  2043. sr.reg2:=how;
  2044. sr.reg3:=longint(SSet);
  2045. sr.reg4:=longint(OldSSet);
  2046. SysCall(Syscall_nr_sigprocmask,sr);
  2047. linuxerror:=errno;
  2048. end;
  2049. Function SigPending:SigSet;
  2050. {
  2051. Allows examination of pending signals. The signal mask of pending
  2052. signals is set in SSet
  2053. }
  2054. Var
  2055. sr : SyscallRegs;
  2056. dummy : Sigset;
  2057. begin
  2058. sr.reg2:=longint(@dummy);
  2059. SysCall(Syscall_nr_sigpending,sr);
  2060. linuxerror:=errno;
  2061. Sigpending:=dummy;
  2062. end;
  2063. Procedure SigSuspend(Mask:Sigset);
  2064. {
  2065. Set the signal mask with Mask, and suspend the program until a signal
  2066. is received.
  2067. }
  2068. Var
  2069. sr : SyscallRegs;
  2070. begin
  2071. sr.reg2:=mask;
  2072. SysCall(Syscall_nr_sigsuspend,sr);
  2073. linuxerror:=errno;
  2074. end;
  2075. Function Signal(Signum:Integer;Handler:PSignalHandler):PSignalHandler;
  2076. {
  2077. Install a new handler for signal Signum.
  2078. The old signal handler is returned.
  2079. This call does, in fact, the same as SigAction.
  2080. }
  2081. var
  2082. sr : Syscallregs;
  2083. begin
  2084. sr.reg2:=signum;
  2085. sr.reg3:=longint(handler);
  2086. Linuxerror:=SysCall(Syscall_nr_signal,sr);
  2087. If linuxerror=Sig_Err then
  2088. begin
  2089. Signal:=nil;
  2090. Linuxerror:=errno;
  2091. end
  2092. else
  2093. begin
  2094. Signal:=pointer(Linuxerror);
  2095. linuxerror:=0;
  2096. end;
  2097. end;
  2098. {******************************************************************************
  2099. IOCtl and Termios calls
  2100. ******************************************************************************}
  2101. Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
  2102. {
  2103. Interface to Unix ioctl call.
  2104. Performs various operations on the filedescriptor Handle.
  2105. Ndx describes the operation to perform.
  2106. Data points to data needed for the Ndx function. The structure of this
  2107. data is function-dependent.
  2108. }
  2109. var
  2110. sr: SysCallRegs;
  2111. begin
  2112. sr.reg2:=Handle;
  2113. sr.reg3:=Ndx;
  2114. sr.reg4:=Longint(Data);
  2115. IOCtl:=(SysCall(Syscall_nr_ioctl,sr)=0);
  2116. LinuxError:=Errno;
  2117. end;
  2118. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  2119. begin
  2120. TCGetAttr:=IOCtl(fd,TCGETS,@tios);
  2121. end;
  2122. Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
  2123. var
  2124. nr:longint;
  2125. begin
  2126. case OptAct of
  2127. TCSANOW : nr:=TCSETS;
  2128. TCSADRAIN : nr:=TCSETSW;
  2129. TCSAFLUSH : nr:=TCSETSF;
  2130. else
  2131. begin
  2132. ErrNo:=Sys_EINVAL;
  2133. TCSetAttr:=false;
  2134. exit;
  2135. end;
  2136. end;
  2137. TCSetAttr:=IOCtl(fd,nr,@Tios);
  2138. end;
  2139. Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
  2140. begin
  2141. tios.c_cflag:=(tios.c_cflag and (not CBAUD)) or speed;
  2142. end;
  2143. Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
  2144. begin
  2145. CFSetISpeed(tios,speed);
  2146. end;
  2147. Procedure CFMakeRaw(var tios:TermIOS);
  2148. begin
  2149. with tios do
  2150. begin
  2151. c_iflag:=c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
  2152. INLCR or IGNCR or ICRNL or IXON));
  2153. c_oflag:=c_oflag and (not OPOST);
  2154. c_lflag:=c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
  2155. c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or CS8;
  2156. end;
  2157. end;
  2158. Function TCSendBreak(fd,duration:longint):boolean;
  2159. begin
  2160. TCSendBreak:=IOCtl(fd,TCSBRK,pointer(duration));
  2161. end;
  2162. Function TCSetPGrp(fd,id:longint):boolean;
  2163. begin
  2164. TCSetPGrp:=IOCtl(fd,TIOCSPGRP,pointer(id));
  2165. end;
  2166. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  2167. begin
  2168. TCGetPGrp:=IOCtl(fd,TIOCGPGRP,@id);
  2169. end;
  2170. Function TCDrain(fd:longint):boolean;
  2171. begin
  2172. TCDrain:=IOCtl(fd,TCSBRK,pointer(1));
  2173. end;
  2174. Function TCFlow(fd,act:longint):boolean;
  2175. begin
  2176. TCFlow:=IOCtl(fd,TCXONC,pointer(act));
  2177. end;
  2178. Function TCFlush(fd,qsel:longint):boolean;
  2179. begin
  2180. TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
  2181. end;
  2182. Function IsATTY(Handle:Longint):Boolean;
  2183. {
  2184. Check if the filehandle described by 'handle' is a TTY (Terminal)
  2185. }
  2186. var
  2187. t : Termios;
  2188. begin
  2189. IsAtty:=TCGetAttr(Handle,t);
  2190. end;
  2191. Function IsATTY(f: text):Boolean;
  2192. {
  2193. Idem as previous, only now for text variables.
  2194. }
  2195. begin
  2196. IsATTY:=IsaTTY(textrec(f).handle);
  2197. end;
  2198. function TTYName(Handle:Longint):string;
  2199. {
  2200. Return the name of the current tty described by handle f.
  2201. returns empty string in case of an error.
  2202. }
  2203. Const
  2204. dev='/dev';
  2205. var
  2206. name : string;
  2207. st : stat;
  2208. mydev,
  2209. myino : longint;
  2210. dirstream : pdir;
  2211. d : pdirent;
  2212. begin
  2213. TTYName:='';
  2214. fstat(handle,st);
  2215. if (errno<>0) and isatty (handle) then
  2216. exit;
  2217. mydev:=st.dev;
  2218. myino:=st.ino;
  2219. dirstream:=opendir(dev);
  2220. if (linuxerror<>0) then
  2221. exit;
  2222. d:=Readdir(dirstream);
  2223. while (d<>nil) do
  2224. begin
  2225. if (d^.ino=myino) then
  2226. begin
  2227. name:=dev+'/'+strpas(@(d^.name));
  2228. fstat(name,st);
  2229. if (linuxerror=0) and (st.dev=mydev) then
  2230. begin
  2231. closedir(dirstream);
  2232. ttyname:=name;
  2233. exit;
  2234. end;
  2235. end;
  2236. d:=Readdir(dirstream);
  2237. end;
  2238. closedir(dirstream);
  2239. end;
  2240. function TTYName(var F:Text):string;
  2241. {
  2242. Idem as previous, only now for text variables;
  2243. }
  2244. begin
  2245. TTYName:=TTYName(textrec(f).handle);
  2246. end;
  2247. {******************************************************************************
  2248. Utility calls
  2249. ******************************************************************************}
  2250. Function Octal(l:longint):longint;
  2251. {
  2252. Convert an octal specified number to decimal;
  2253. }
  2254. var
  2255. octnr,
  2256. oct : longint;
  2257. begin
  2258. octnr:=0;
  2259. oct:=0;
  2260. while (l>0) do
  2261. begin
  2262. oct:=oct or ((l mod 10) shl octnr);
  2263. l:=l div 10;
  2264. inc(octnr,3);
  2265. end;
  2266. Octal:=oct;
  2267. end;
  2268. Function StringToPPChar(Var S:STring):ppchar;
  2269. {
  2270. Create a PPChar to structure of pchars which are the arguments specified
  2271. in the string S. Especially usefull for creating an ArgV for Exec-calls
  2272. }
  2273. var
  2274. nr : longint;
  2275. Buf : ^char;
  2276. p : ppchar;
  2277. begin
  2278. s:=s+#0;
  2279. buf:=@s[1];
  2280. nr:=0;
  2281. while(buf^<>#0) do
  2282. begin
  2283. while (buf^ in [' ',#8,#10]) do
  2284. buf:=buf+1;
  2285. inc(nr);
  2286. while not (buf^ in [' ',#0,#8,#10]) do
  2287. buf:=buf+1;
  2288. end;
  2289. getmem(p,nr*4);
  2290. StringToPPChar:=p;
  2291. if p=nil then
  2292. begin
  2293. LinuxError:=sys_enomem;
  2294. exit;
  2295. end;
  2296. buf:=@s[1];
  2297. while (buf^<>#0) do
  2298. begin
  2299. while (buf^ in [' ',#8,#10]) do
  2300. begin
  2301. buf^:=#0;
  2302. buf:=buf+1;
  2303. end;
  2304. p^:=buf;
  2305. p:=p+4;
  2306. p^:=nil;
  2307. while not (buf^ in [' ',#0,#8,#10]) do
  2308. buf:=buf+1;
  2309. end;
  2310. end;
  2311. Function FExpand(Const Path:PathStr):PathStr;
  2312. var
  2313. temp : pathstr;
  2314. i,j : longint;
  2315. p : pchar;
  2316. Begin
  2317. {Remove eventual drive - doesn't exist in Linux}
  2318. if path[2]=':' then
  2319. i:=3
  2320. else
  2321. i:=1;
  2322. temp:='';
  2323. {Replace ~/ with $HOME}
  2324. if (path[i]='~') and ((i+1>length(path)) or (path[i+1]='/')) then
  2325. begin
  2326. p:=getenv('HOME');
  2327. if not (p=nil) then
  2328. Insert(StrPas(p),temp,i);
  2329. i:=1;
  2330. temp:=temp+Copy(Path,2,255);
  2331. end;
  2332. {Do we have an absolute path ? No - prefix the current dir}
  2333. if temp='' then
  2334. begin
  2335. if path[i]<>'/' then
  2336. getdir(0,temp)
  2337. else
  2338. inc(i);
  2339. temp:=temp+'/'+copy(path,i,length(path)-i+1)+'/';
  2340. end;
  2341. {First remove all references to '/./'}
  2342. while pos('/./',temp)<>0 do
  2343. delete(temp,pos('/./',temp),2);
  2344. {Now remove also all references to '/../' + of course previous dirs..}
  2345. repeat
  2346. i:=pos('/../',temp);
  2347. {Find the pos of the previous dir}
  2348. if i>1 then
  2349. begin
  2350. j:=i-1;
  2351. while (j>1) and (temp[j]<>'/') do
  2352. dec (j);{temp[1] is always '/'}
  2353. delete(temp,j,i-j+3);
  2354. end
  2355. else
  2356. if i=1 then {i=1, so we have temp='/../something', just delete '/../'}
  2357. delete(temp,1,3);
  2358. until i=0;
  2359. {Remove ending . and / which may exist}
  2360. if (length(temp)>0) and (temp[length(temp)]='/') then
  2361. dec(byte(temp[0]));
  2362. fexpand:=temp;
  2363. End;
  2364. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  2365. {
  2366. Searches for a file 'path' in the list of direcories in 'dirlist'.
  2367. returns an empty string if not found. Wildcards are NOT allowed.
  2368. If dirlist is empty, it is set to '.'
  2369. }
  2370. Var
  2371. NewDir : PathStr;
  2372. p1 : Longint;
  2373. Info : Stat;
  2374. Begin
  2375. {Replace ':' with ';'}
  2376. for p1:=1to length(dirlist) do
  2377. if dirlist[p1]=':' then
  2378. dirlist[p1]:=';';
  2379. {Check for WildCards}
  2380. If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
  2381. FSearch:='' {No wildcards allowed in these things.}
  2382. Else
  2383. Begin
  2384. Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
  2385. Repeat
  2386. p1:=Pos(';',DirList);
  2387. If p1=0 Then
  2388. p1:=255;
  2389. NewDir:=Copy(DirList,1,P1 - 1);
  2390. if NewDir[Length(NewDir)]<>'/' then
  2391. NewDir:=NewDir+'/';
  2392. NewDir:=NewDir+Path;
  2393. Delete(DirList,1,p1);
  2394. if FStat(NewDir,Info) then
  2395. Begin
  2396. If Pos('./',NewDir)=1 Then
  2397. Delete(NewDir,1,2);
  2398. {DOS strips off an initial .\}
  2399. End
  2400. Else
  2401. NewDir:='';
  2402. Until (DirList='') or (Length(NewDir) > 0);
  2403. FSearch:=NewDir;
  2404. End;
  2405. End;
  2406. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  2407. Var
  2408. DotPos,SlashPos,i : longint;
  2409. Begin
  2410. SlashPos:=0;
  2411. DotPos:=256;
  2412. i:=Length(Path);
  2413. While (i>0) and (SlashPos=0) Do
  2414. Begin
  2415. If (DotPos=256) and (Path[i]='.') Then
  2416. DotPos:=i;
  2417. If (Path[i]='/') Then
  2418. SlashPos:=i;
  2419. Dec(i);
  2420. End;
  2421. Ext:=Copy(Path,DotPos,255);
  2422. Dir:=Copy(Path,1,SlashPos);
  2423. Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
  2424. End;
  2425. Function Dirname(Const path:pathstr):pathstr;
  2426. {
  2427. This function returns the directory part of a complete path.
  2428. Unless the directory is root '/', The last character is not
  2429. a slash.
  2430. }
  2431. var
  2432. Dir,Name,Ext : string;
  2433. begin
  2434. FSplit(Path,Dir,Name,Ext);
  2435. if length(Dir)>1 then
  2436. Delete(Dir,length(Dir),1);
  2437. DirName:=Dir;
  2438. end;
  2439. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  2440. {
  2441. This function returns the filename part of a complete path. If suf is
  2442. supplied, it is cut off the filename.
  2443. }
  2444. var
  2445. Dir,Name,Ext : string;
  2446. begin
  2447. FSplit(Path,Dir,Name,Ext);
  2448. if Suf<>Ext then
  2449. Name:=Name+Ext;
  2450. BaseName:=Name;
  2451. end;
  2452. Function FNMatch(const Pattern,Name:string):Boolean;
  2453. Var
  2454. LenPat,LenName : longint;
  2455. Function DoFNMatch(i,j:longint):Boolean;
  2456. Var
  2457. Found : boolean;
  2458. Begin
  2459. Found:=true;
  2460. While Found and (i<=LenPat) Do
  2461. Begin
  2462. Case Pattern[i] of
  2463. '?' : Found:=(j<=LenName);
  2464. '*' : Begin
  2465. {find the next character in pattern, different of ? and *}
  2466. while Found and (i<LenPat) do
  2467. begin
  2468. inc(i);
  2469. case Pattern[i] of
  2470. '*' : ;
  2471. '?' : begin
  2472. inc(j);
  2473. Found:=(j<=LenName);
  2474. end;
  2475. else
  2476. Found:=false;
  2477. end;
  2478. end;
  2479. {Now, find in name the character which i points to, if the * or ?
  2480. wasn't the last character in the pattern, else, use up all the
  2481. chars in name}
  2482. Found:=true;
  2483. if (i<=LenPat) then
  2484. begin
  2485. repeat
  2486. {find a letter (not only first !) which maches pattern[i]}
  2487. while (j<=LenName) and (name[j]<>pattern[i]) do
  2488. inc (j);
  2489. if (j<LenName) then
  2490. begin
  2491. if DoFnMatch(i+1,j+1) then
  2492. begin
  2493. i:=LenPat;
  2494. j:=LenName;{we can stop}
  2495. Found:=true;
  2496. end
  2497. else
  2498. inc(j);{We didn't find one, need to look further}
  2499. end;
  2500. until (j>=LenName);
  2501. end
  2502. else
  2503. j:=LenName;{we can stop}
  2504. end;
  2505. else {not a wildcard character in pattern}
  2506. Found:=(j<=LenName) and (pattern[i]=name[j]);
  2507. end;
  2508. inc(i);
  2509. inc(j);
  2510. end;
  2511. DoFnMatch:=Found and (j>LenName);
  2512. end;
  2513. Begin {start FNMatch}
  2514. LenPat:=Length(Pattern);
  2515. LenName:=Length(Name);
  2516. FNMatch:=DoFNMatch(1,1);
  2517. End;
  2518. Procedure Globfree(var p : pglob);
  2519. {
  2520. Release memory occupied by pglob structure, and names in it.
  2521. sets p to nil.
  2522. }
  2523. var
  2524. temp : pglob;
  2525. begin
  2526. while p<>nil do
  2527. begin
  2528. temp:=p^.next;
  2529. if p^.name<>nil then
  2530. freemem(p^.name,strlen(p^.name));
  2531. dispose(p);
  2532. p:=temp;
  2533. end;
  2534. end;
  2535. Function Glob(Const path:pathstr):pglob;
  2536. {
  2537. Fills a tglob structure with entries matching path,
  2538. and returns a pointer to it. Returns nil on error,
  2539. linuxerror is set accordingly.
  2540. }
  2541. var
  2542. temp : string[255];
  2543. thedir : pdir;
  2544. buffer : pdirent;
  2545. root,run : pglob;
  2546. begin
  2547. { Get directory }
  2548. if dirname(path)='' then
  2549. temp:='.'
  2550. else
  2551. temp:=dirname(path);
  2552. temp:=temp+#0;
  2553. thedir:=opendir(@temp[1]);
  2554. if thedir=nil then
  2555. begin
  2556. glob:=nil;
  2557. linuxerror:=errno;
  2558. exit;
  2559. end;
  2560. temp:=basename(path,'');{ get the pattern }
  2561. if thedir^.fd<0 then
  2562. begin
  2563. linuxerror:=errno;
  2564. glob:=nil;
  2565. exit;
  2566. end;
  2567. {get the entries}
  2568. new(root);
  2569. run:=root;
  2570. repeat
  2571. buffer:=Sys_readdir(thedir);
  2572. if buffer<>nil then
  2573. begin
  2574. if fnmatch(temp,strpas(@(buffer^.name[0]))) then
  2575. begin
  2576. { get memory for pglob }
  2577. new(run^.next);
  2578. if run^.next=nil then
  2579. begin
  2580. linuxerror:=Sys_ENOMEM;
  2581. globfree(root);
  2582. glob:=nil;
  2583. exit;
  2584. end
  2585. else
  2586. begin
  2587. run:=run^.next;
  2588. run^.next:=nil;
  2589. end;
  2590. { Get memory for name }
  2591. getmem(run^.name,strlen(@(buffer^.name[0]))+1);
  2592. if run^.name=nil then
  2593. begin
  2594. linuxerror:=Sys_ENOMEM;
  2595. globfree(root);
  2596. glob:=nil;
  2597. exit;
  2598. end;
  2599. move(buffer^.name[0],run^.name^,strlen(@(buffer^.name[0]))+1);
  2600. end;{ if fnmatch }
  2601. end { buffer <> nil }
  2602. else
  2603. begin
  2604. run:=root;
  2605. if root^.next<>nil then
  2606. root:=root^.next;{ put root on first entry}
  2607. if run<>nil then
  2608. begin
  2609. run^.next:=nil;
  2610. globfree(run);
  2611. end;
  2612. end;
  2613. until buffer=nil;
  2614. if root^.name=nil then
  2615. begin
  2616. dispose(root);
  2617. linuxerror:=0;
  2618. glob:=nil;
  2619. end
  2620. else
  2621. glob:=root;
  2622. end;
  2623. {--------------------------------
  2624. FiledescriptorSets
  2625. --------------------------------}
  2626. Procedure FD_Zero(var fds:fdSet);
  2627. {
  2628. Clear the set of filedescriptors
  2629. }
  2630. begin
  2631. FillChar(fds,sizeof(fdSet),0);
  2632. end;
  2633. Procedure FD_Clr(fd:longint;var fds:fdSet);
  2634. {
  2635. Remove fd from the set of filedescriptors
  2636. }
  2637. begin
  2638. fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
  2639. end;
  2640. Procedure FD_Set(fd:longint;var fds:fdSet);
  2641. {
  2642. Add fd to the set of filedescriptors
  2643. }
  2644. begin
  2645. fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
  2646. end;
  2647. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  2648. {
  2649. Test if fd is part of the set of filedescriptors
  2650. }
  2651. begin
  2652. FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
  2653. end;
  2654. Function GetFS (var T:Text):longint;
  2655. {
  2656. Get File Descriptor of a text file.
  2657. }
  2658. begin
  2659. if textrec(t).mode=fmclosed then
  2660. exit(-1)
  2661. else
  2662. GETFS:=textrec(t).Handle
  2663. end;
  2664. Function GetFS(Var F:File):longint;
  2665. {
  2666. Get File Descriptor of an unTyped file.
  2667. }
  2668. begin
  2669. { Handle and mode are on the same place in textrec and filerec. }
  2670. if filerec(f).mode=fmclosed then
  2671. exit(-1)
  2672. else
  2673. GETFS:=filerec(f).Handle
  2674. end;
  2675. {--------------------------------
  2676. Stat.Mode Macro's
  2677. --------------------------------}
  2678. Function S_ISLNK(m:integer):boolean;
  2679. {
  2680. Check mode field of inode for link.
  2681. }
  2682. begin
  2683. S_ISLNK:=(m and STAT_IFMT)=STAT_IFLNK;
  2684. end;
  2685. Function S_ISREG(m:integer):boolean;
  2686. {
  2687. Check mode field of inode for regular file.
  2688. }
  2689. begin
  2690. S_ISREG:=(m and STAT_IFMT)=STAT_IFREG;
  2691. end;
  2692. Function S_ISDIR(m:integer):boolean;
  2693. {
  2694. Check mode field of inode for directory.
  2695. }
  2696. begin
  2697. S_ISDIR:=(m and STAT_IFMT)=STAT_IFDIR;
  2698. end;
  2699. Function S_ISCHR(m:integer):boolean;
  2700. {
  2701. Check mode field of inode for character device.
  2702. }
  2703. begin
  2704. S_ISCHR:=(m and STAT_IFMT)=STAT_IFCHR;
  2705. end;
  2706. Function S_ISBLK(m:integer):boolean;
  2707. {
  2708. Check mode field of inode for block device.
  2709. }
  2710. begin
  2711. S_ISBLK:=(m and STAT_IFMT)=STAT_IFBLK;
  2712. end;
  2713. Function S_ISFIFO(m:integer):boolean;
  2714. {
  2715. Check mode field of inode for named pipe (FIFO).
  2716. }
  2717. begin
  2718. S_ISFIFO:=(m and STAT_IFMT)=STAT_IFIFO;
  2719. end;
  2720. Function S_ISSOCK(m:integer):boolean;
  2721. {
  2722. Check mode field of inode for socket.
  2723. }
  2724. begin
  2725. S_ISSOCK:=(m and STAT_IFMT)=STAT_IFSOCK;
  2726. end;
  2727. Begin
  2728. InitEpochToLocal;
  2729. End.
  2730. {
  2731. $Log$
  2732. Revision 1.6 1998-04-15 11:23:53 michael
  2733. + Added some calls to make common API more efficient
  2734. Revision 1.5 1998/04/10 15:23:03 michael
  2735. + Pclose now returns exit status of process
  2736. Revision 1.4 1998/04/07 13:08:29 michael
  2737. + Added flock for file locking
  2738. Revision 1.3 1998/04/07 12:27:41 peter
  2739. * fixed fexpand('..')
  2740. Revision 1.2 1998/04/04 17:07:17 michael
  2741. + Fixed AssignStream, it completely refused to work
  2742. Revision 1.1.1.1 1998/03/25 11:18:43 root
  2743. * Restored version
  2744. Revision 1.17 1998/02/23 14:17:51 michael
  2745. * Fixed pclose bug. Programs went into a neverending loop.
  2746. Revision 1.16 1998/02/08 01:58:11 peter
  2747. + Overloaded functions Dup/Dup2 for longint,file
  2748. * Better Pipe support
  2749. * Some cleanup
  2750. Revision 1.15 1998/01/26 12:01:18 michael
  2751. + Added log at the end
  2752. revision 1.14
  2753. date: 1998/01/19 10:03:01; author: michael; state: Exp; lines: +2 -2
  2754. * BugFix for findfirst/findnext routines. (From Peter Vreman)
  2755. ----------------------------
  2756. revision 1.13
  2757. date: 1998/01/16 00:02:57; author: michael; state: Exp; lines: +25 -9
  2758. FExpand expands ~/ to HOME (Fro Peter Vreman)
  2759. ----------------------------
  2760. revision 1.12
  2761. date: 1998/01/13 17:14:38; author: michael; state: Exp; lines: +23 -1
  2762. + Entered new FStat call using File or Text var.
  2763. + GetTme call in DOS now refers to Linux.gettime !
  2764. ----------------------------
  2765. revision 1.11
  2766. date: 1998/01/11 02:49:36; author: michael; state: Exp; lines: +29 -19
  2767. + Fixed bugs discoverd when writing examples, changed procedure to
  2768. function : boolean in some cases.
  2769. ----------------------------
  2770. revision 1.10
  2771. date: 1998/01/08 00:18:13; author: michael; state: Exp; lines: +17 -7
  2772. * Made Dup,Dup2 functions retuning Boolean;
  2773. * Name in Dirent is now Array [0..255] of char instead of string.
  2774. + Implemented OpenDir with string as path, instead of pchar.
  2775. ----------------------------
  2776. revision 1.9
  2777. date: 1998/01/06 15:04:50; author: michael; state: Exp; lines: +5 -5
  2778. * Some boolean functions had an undefined result. Fixed that.
  2779. ----------------------------
  2780. revision 1.8
  2781. date: 1998/01/05 16:43:19; author: michael; state: Exp; lines: +19 -5
  2782. * Nicer implementation of GetDate and GetTime, using a newly implemented
  2783. GetTimeOfDay function (overloaded). (From Peter Vreman)
  2784. ----------------------------
  2785. revision 1.7
  2786. date: 1997/12/22 18:50:31; author: michael; state: Exp; lines: +8 -5
  2787. * Bug fixed in fexpand, extra / was sometimes added for filename
  2788. * fdsets are treated correctly now.
  2789. ----------------------------
  2790. revision 1.6
  2791. date: 1997/12/19 15:23:02; author: michael; state: Exp; lines: +9 -9
  2792. * changed some termios functions to procedures.
  2793. ----------------------------
  2794. revision 1.5
  2795. date: 1997/12/15 12:56:19; author: michael; state: Exp; lines: +4 -4
  2796. * fixed bug in fdset handling functions.
  2797. ----------------------------
  2798. revision 1.4
  2799. date: 1997/12/10 13:32:43; author: michael; state: Exp; lines: +558 -326
  2800. + added termios functies
  2801. * epochtolocal geeft nu tijd in Local time...
  2802. ----------------------------
  2803. revision 1.3
  2804. date: 1997/12/04 13:43:51; author: michael; state: Exp; lines: +61 -73
  2805. * changed attribute and time functions.
  2806. ----------------------------
  2807. revision 1.2
  2808. date: 1997/12/01 12:31:15; author: michael; state: Exp; lines: +15 -22
  2809. + Added copyright reference in header.
  2810. ----------------------------
  2811. revision 1.1
  2812. date: 1997/11/27 08:33:54; author: michael; state: Exp;
  2813. Initial revision
  2814. ----------------------------
  2815. revision 1.1.1.1
  2816. date: 1997/11/27 08:33:54; author: michael; state: Exp; lines: +0 -0
  2817. FPC RTL CVS start
  2818. =============================================================================
  2819. Date Version Who Comments
  2820. 96/97 0.8 Michael Initial implementation
  2821. Code cleanup
  2822. 11/97 0.9 Peter <[email protected]>
  2823. Code cleanup, added
  2824. some calls
  2825. ---------------------------------------------------------------------
  2826. }