linux.pp 74 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533
  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. function CreateShellArgV(const prog:string):ppchar;
  423. Procedure Execve(Path:pathstr;args:ppchar;ep:ppchar);
  424. Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
  425. Procedure Execv(const path:pathstr;args:ppchar);
  426. Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
  427. Procedure Execl(const Todo:string);
  428. Procedure Execle(Todo:string;Ep:ppchar);
  429. Procedure Execlp(Todo:string;Ep:ppchar);
  430. Function Shell(const Command:String):Longint;
  431. Function Fork:longint;
  432. Function WaitPid(Pid:longint;Status:pointer;Options:Integer):Longint;
  433. Procedure Nice(N:integer);
  434. Function GetPriority(Which,Who:Integer):integer;
  435. Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
  436. Function GetPid:LongInt;
  437. Function GetPPid:LongInt;
  438. Function GetUid:Longint;
  439. Function GetEUid:Longint;
  440. Function GetGid:Longint;
  441. Function GetEGid:Longint;
  442. {**************************
  443. File Handling
  444. ***************************}
  445. Function fdOpen(pathname:string;flags:longint):longint;
  446. Function fdOpen(pathname:string;flags,mode:longint):longint;
  447. Function fdOpen(pathname:pchar;flags:longint):longint;
  448. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  449. Function fdClose(fd:longint):boolean;
  450. Function fdRead(fd:longint;var buf;size:longint):longint;
  451. Function fdWrite(fd:longint;var buf;size:longint):longint;
  452. Function fdTruncate(fd,size:longint):boolean;
  453. Function fdSeek (fd,pos,seektype :longint): longint;
  454. Function fdFlush (fd : Longint) : Boolean;
  455. Function Link(OldPath,NewPath:pathstr):boolean;
  456. Function SymLink(OldPath,NewPath:pathstr):boolean;
  457. Function UnLink(Path:pathstr):boolean;
  458. Function UnLink(Path:pchar):Boolean;
  459. Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
  460. Function Chmod(path:pathstr;Newmode:longint):boolean;
  461. Function Utime(path:pathstr;utim:utimbuf):boolean;
  462. Function Access(Path:Pathstr ;mode:integer):boolean;
  463. Function Umask(Mask:Integer):integer;
  464. Function Flock (fd,mode : longint) : boolean;
  465. Function Flock (var T : text;mode : longint) : boolean;
  466. Function Flock (var F : File;mode : longint) : boolean;
  467. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  468. Function FStat(Fd:longint;Var Info:stat):Boolean;
  469. Function FStat(var F:Text;Var Info:stat):Boolean;
  470. Function FStat(var F:File;Var Info:stat):Boolean;
  471. Function Lstat(Filename: PathStr;var Info:stat):Boolean;
  472. Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
  473. Function FSStat(Fd: Longint;Var Info:statfs):Boolean;
  474. Function Fcntl(Fd:Text;Cmd:Integer):integer;
  475. Procedure Fcntl(Fd:Text;Cmd:Integer;Arg:Longint);
  476. Function Dup(oldfile,newfile:longint):Boolean;
  477. Function Dup(var oldfile,newfile:text):Boolean;
  478. Function Dup(var oldfile,newfile:file):Boolean;
  479. Function Dup2(oldfile,newfile:longint):Boolean;
  480. Function Dup2(var oldfile,newfile:text):Boolean;
  481. Function Dup2(var oldfile,newfile:file):Boolean;
  482. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
  483. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  484. Function SelectText(var T:Text;TimeOut :PTimeVal):Longint;
  485. {**************************
  486. Directory Handling
  487. ***************************}
  488. Function OpenDir(f:pchar):pdir;
  489. Function OpenDir(f: String):pdir;
  490. function CloseDir(p:pdir):integer;
  491. Function ReadDir(p:pdir):pdirent;
  492. procedure SeekDir(p:pdir;off:longint);
  493. function TellDir(p:pdir):longint;
  494. {**************************
  495. Pipe/Fifo/Stream
  496. ***************************}
  497. Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
  498. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  499. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  500. Function PClose(Var F:text) : longint;
  501. Function PClose(Var F:file) : longint;
  502. Procedure POpen(var F:text;const Prog:String;rw:char);
  503. Procedure POpen(var F:file;const Prog:String;rw:char);
  504. Function mkFifo(pathname:string;mode:longint):boolean;
  505. Procedure AssignStream(Var StreamIn,Streamout:text;Const Prog:String);
  506. {**************************
  507. General information
  508. ***************************}
  509. Function GetDomainName:String;
  510. Function GetHostName:String;
  511. Function GetEnv(P:string):Pchar;
  512. Function Sysinfo(var Info:TSysinfo):Boolean;
  513. Function Uname(var unamerec:utsname):Boolean;
  514. {**************************
  515. Signal
  516. ***************************}
  517. Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
  518. Procedure SigProcMask (How:Integer;SSet,OldSSet:PSigSet);
  519. Function SigPending:SigSet;
  520. Procedure SigSuspend(Mask:Sigset);
  521. Function Signal(Signum:Integer;Handler:PSignalHandler):PSignalHandler;
  522. Function Kill(Pid:longint;Sig:integer):integer;
  523. {**************************
  524. IOCtl/Termios Functions
  525. ***************************}
  526. Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
  527. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  528. Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
  529. Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
  530. Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
  531. Procedure CFMakeRaw(var tios:TermIOS);
  532. Function TCSendBreak(fd,duration:longint):boolean;
  533. Function TCSetPGrp(fd,id:longint):boolean;
  534. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  535. Function TCFlush(fd,qsel:longint):boolean;
  536. Function TCDrain(fd:longint):boolean;
  537. Function TCFlow(fd,act:longint):boolean;
  538. Function IsATTY(Handle:Longint):Boolean;
  539. Function IsATTY(f:text):Boolean;
  540. function TTYname(Handle:Longint):string;
  541. function TTYname(var F:Text):string;
  542. {**************************
  543. Port IO functions
  544. ***************************}
  545. Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
  546. Procedure WritePort (Port : Longint; Value : Byte);
  547. Procedure WritePort (Port : Longint; Value : Word);
  548. Procedure WritePort (Port : Longint; Value : Longint);
  549. Procedure WritePortl (Port : Longint; Var Buf; Count: longint);
  550. Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
  551. Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
  552. Procedure ReadPort (Port : Longint; Var Value : Byte);
  553. Procedure ReadPort (Port : Longint; Var Value : Word);
  554. Procedure ReadPort (Port : Longint; Var Value : Longint);
  555. Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
  556. Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
  557. Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
  558. {**************************
  559. Utility functions
  560. ***************************}
  561. Function Octal(l:longint):longint;
  562. Function FExpand(Const Path: PathStr):PathStr;
  563. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  564. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  565. Function Dirname(Const path:pathstr):pathstr;
  566. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  567. Function FNMatch(const Pattern,Name:string):Boolean;
  568. Function Glob(Const path:pathstr):pglob;
  569. Procedure Globfree(var p:pglob);
  570. Function StringToPPChar(Var S:STring):ppchar;
  571. Function GetFS(var T:Text):longint;
  572. Function GetFS(Var F:File):longint;
  573. {Filedescriptorsets}
  574. Procedure FD_Zero(var fds:fdSet);
  575. Procedure FD_Clr(fd:longint;var fds:fdSet);
  576. Procedure FD_Set(fd:longint;var fds:fdSet);
  577. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  578. {Stat.Mode Types}
  579. Function S_ISLNK(m:integer):boolean;
  580. Function S_ISREG(m:integer):boolean;
  581. Function S_ISDIR(m:integer):boolean;
  582. Function S_ISCHR(m:integer):boolean;
  583. Function S_ISBLK(m:integer):boolean;
  584. Function S_ISFIFO(m:integer):boolean;
  585. Function S_ISSOCK(m:integer):boolean;
  586. {******************************************************************************
  587. Implementation
  588. ******************************************************************************}
  589. Implementation
  590. Uses Strings;
  591. var
  592. LocalTZ:TimeZone;
  593. { Get the definitions of textrec and filerec }
  594. {$i textrec.inc}
  595. {$i filerec.inc}
  596. { Raw System calls are in Syscalls.inc}
  597. {$i syscalls.inc}
  598. {******************************************************************************
  599. Process related calls
  600. ******************************************************************************}
  601. function CreateShellArgV(const prog:string):ppchar;
  602. {
  603. Create an argv which executes a command in a shell using /bin/sh -c
  604. }
  605. var
  606. pp,p : ppchar;
  607. temp : string;
  608. begin
  609. getmem(pp,4*4);
  610. temp:='/bin/sh'#0'-c'#0+prog+#0;
  611. pp^:=@temp[1];
  612. p:=pp+4;
  613. p^:=@temp[9];
  614. p:=p+4;
  615. p^:=@temp[12];
  616. p:=p+4;
  617. p^:=Nil;
  618. CreateShellArgV:=pp;
  619. end;
  620. Function Fork:longint;
  621. {
  622. This function issues the 'fork' System call. the program is duplicated in memory
  623. and Execution continues in parent and child process.
  624. In the parent process, fork returns the PID of the child. In the child process,
  625. zero is returned.
  626. A negative value indicates that an error has occurred, the error is returned in
  627. LinuxError.
  628. }
  629. var
  630. regs:SysCallregs;
  631. begin
  632. Fork:=SysCall(SysCall_nr_fork,regs);
  633. LinuxError:=Errno;
  634. End;
  635. Procedure Execve(path:pathstr;args:ppchar;ep:ppchar);
  636. {
  637. Replaces the current program by the program specified in path,
  638. arguments in args are passed to Execve.
  639. environment specified in ep is passed on.
  640. }
  641. var
  642. regs:SysCallregs;
  643. begin
  644. path:=path+#0;
  645. regs.reg2:=longint(@path[1]);
  646. regs.reg3:=longint(args);
  647. regs.reg4:=longint(ep);
  648. SysCall(SysCall_nr_Execve,regs);
  649. { This only gets set when the call fails, otherwise we don't get here ! }
  650. Linuxerror:=errno;
  651. end;
  652. Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
  653. {
  654. Replaces the current program by the program specified in path,
  655. arguments in args are passed to Execve.
  656. environment specified in ep is passed on.
  657. }
  658. var
  659. regs:SysCallregs;
  660. begin
  661. regs.reg2:=longint(path);
  662. regs.reg3:=longint(args);
  663. regs.reg4:=longint(ep);
  664. SysCall(SysCall_nr_Execve,regs);
  665. { This only gets set when the call fails, otherwise we don't get here ! }
  666. Linuxerror:=errno;
  667. end;
  668. Procedure Execv(const path:pathstr;args:ppchar);
  669. {
  670. Replaces the current program by the program specified in path,
  671. arguments in args are passed to Execve.
  672. the current environment is passed on.
  673. }
  674. begin
  675. Execve(path,args,envp); {On error linuxerror will get set there}
  676. end;
  677. Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
  678. {
  679. This does the same as Execve, only it searches the PATH environment
  680. for the place of the Executable, except when Path starts with a slash.
  681. if the PATH environment variable is unavailable, the path is set to '.'
  682. }
  683. var
  684. thepath : string;
  685. begin
  686. if path[1]<>'/' then
  687. begin
  688. Thepath:=strpas(getenv('PATH'));
  689. if thepath='' then
  690. thepath:='.';
  691. Path:=FSearch(path,thepath)
  692. end
  693. else
  694. Path:='';
  695. if Path='' then
  696. linuxerror:=Sys_enoent
  697. else
  698. Execve(Path,args,ep);{On error linuxerror will get set there}
  699. end;
  700. Procedure Execle(Todo:string;Ep:ppchar);
  701. {
  702. This procedure takes the string 'Todo', parses it for command and
  703. command options, and Executes the command with the given options.
  704. The string 'Todo' shoud be of the form 'command options', options
  705. separated by commas.
  706. the PATH environment is not searched for 'command'.
  707. The specified environment(in 'ep') is passed on to command
  708. }
  709. var
  710. p : ppchar;
  711. begin
  712. p:=StringToPPChar(ToDo);
  713. if (p=nil) or (p^=nil) then
  714. exit;
  715. ExecVE(p^,p,EP);
  716. end;
  717. Procedure Execl(const Todo:string);
  718. {
  719. This procedure takes the string 'Todo', parses it for command and
  720. command options, and Executes the command with the given options.
  721. The string 'Todo' shoud be of the form 'command options', options
  722. separated by commas.
  723. the PATH environment is not searched for 'command'.
  724. The current environment is passed on to command
  725. }
  726. begin
  727. ExecLE(ToDo,EnvP);
  728. end;
  729. Procedure Execlp(Todo:string;Ep:ppchar);
  730. {
  731. This procedure takes the string 'Todo', parses it for command and
  732. command options, and Executes the command with the given options.
  733. The string 'Todo' shoud be of the form 'command options', options
  734. separated by commas.
  735. the PATH environment is searched for 'command'.
  736. The specified environment (in 'ep') is passed on to command
  737. }
  738. var
  739. p : ppchar;
  740. begin
  741. p:=StringToPPchar(todo);
  742. if (p=nil) or (p^=nil) then
  743. exit;
  744. ExecVP(StrPas(p^),p,EP);
  745. end;
  746. Function WaitPid(Pid:longint;Status:pointer;Options:Integer):Longint;
  747. {
  748. Waits until a child with PID Pid exits, or returns if it is exited already.
  749. Any resources used by the child are freed.
  750. The exit status is reported in the adress referred to by Status. It should
  751. be a longint.
  752. }
  753. var
  754. regs : SysCallregs;
  755. begin
  756. regs.reg2:=pid;
  757. regs.reg3:=longint(status);
  758. regs.reg4:=options;
  759. WaitPid:=SysCall(SysCall_nr_waitpid,regs);
  760. LinuxError:=errno;
  761. end;
  762. Function Shell(const Command:String):Longint;
  763. {
  764. Executes the shell, and passes it the string Command. (Through /bin/sh -c)
  765. The current environment is passed to the shell.
  766. It waits for the shell to exit, and returns its exit status.
  767. If the Exec call failed exit status 127 is reported.
  768. }
  769. var
  770. p : ppchar;
  771. temp,pid : longint;
  772. begin
  773. pid:=fork;
  774. if pid=-1 then
  775. exit; {Linuxerror already set in Fork}
  776. if pid=0 then
  777. begin
  778. {This is the child.}
  779. p:=CreateShellArgv(command);
  780. Execve(p^,p,envp);
  781. exit(127);
  782. end;
  783. temp:=0;
  784. WaitPid(pid,@temp,0);{Linuxerror is set there}
  785. Shell:=temp;{ Return exit status }
  786. end;
  787. Function GetPriority(Which,Who:Integer):integer;
  788. {
  789. Get Priority of process, process group, or user.
  790. Which : selects what kind of priority is used.
  791. can be one of the following predefined Constants :
  792. Prio_User.
  793. Prio_PGrp.
  794. Prio_Process.
  795. Who : depending on which, this is , respectively :
  796. Uid
  797. Pid
  798. Process Group id
  799. Errors are reported in linuxerror _only_. (priority can be negative)
  800. }
  801. var
  802. sr : Syscallregs;
  803. begin
  804. errno:=0;
  805. if (which<prio_process) or (which>prio_user) then
  806. begin
  807. { We can save an interrupt here }
  808. getpriority:=0;
  809. linuxerror:=Sys_einval;
  810. end
  811. else
  812. begin
  813. sr.reg2:=which;
  814. sr.reg3:=who;
  815. getpriority:=SysCall(Syscall_nr_getpriority,sr);
  816. linuxerror:=errno;
  817. end;
  818. end;
  819. Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
  820. {
  821. Set Priority of process, process group, or user.
  822. Which : selects what kind of priority is used.
  823. can be one of the following predefined Constants :
  824. Prio_User.
  825. Prio_PGrp.
  826. Prio_Process.
  827. Who : depending on value of which, this is, respectively :
  828. Uid
  829. Pid
  830. Process Group id
  831. what : A number between -20 and 20. -20 is most favorable, 20 least.
  832. 0 is the default.
  833. }
  834. var
  835. sr : Syscallregs;
  836. begin
  837. errno:=0;
  838. if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
  839. linuxerror:=Sys_einval { We can save an interrupt here }
  840. else
  841. begin
  842. sr.reg2:=which;
  843. sr.reg3:=who;
  844. sr.reg4:=what;
  845. SysCall(Syscall_nr_setpriority,sr);
  846. linuxerror:=errno;
  847. end;
  848. end;
  849. Procedure Nice(N:integer);
  850. {
  851. Set process priority. A positive N means a lower priority.
  852. A negative N decreases priority.
  853. }
  854. var
  855. sr : Syscallregs;
  856. begin
  857. sr.reg2:=n;
  858. SysCall(Syscall_nr_nice,sr);
  859. linuxerror:=errno;
  860. end;
  861. Function GetPid:LongInt;
  862. {
  863. Get Process ID.
  864. }
  865. var
  866. regs : SysCallregs;
  867. begin
  868. GetPid:=SysCall(SysCall_nr_getpid,regs);
  869. linuxerror:=errno;
  870. end;
  871. Function GetPPid:LongInt;
  872. {
  873. Get Process ID of parent process.
  874. }
  875. var
  876. regs : SysCallregs;
  877. begin
  878. GetPpid:=SysCall(SysCall_nr_getppid,regs);
  879. linuxerror:=errno;
  880. end;
  881. Function GetUid:Longint;
  882. {
  883. Get User ID.
  884. }
  885. var
  886. regs : SysCallregs;
  887. begin
  888. GetUid:=SysCall(SysCall_nr_getuid,regs);
  889. Linuxerror:=errno;
  890. end;
  891. Function GetEUid:Longint;
  892. {
  893. Get _effective_ User ID.
  894. }
  895. var
  896. regs : SysCallregs;
  897. begin
  898. GetEuid:=SysCall(SysCall_nr_geteuid,regs);
  899. Linuxerror:=errno;
  900. end;
  901. Function GetGid:Longint;
  902. {
  903. Get Group ID.
  904. }
  905. var
  906. regs : SysCallregs;
  907. begin
  908. Getgid:=SysCall(SysCall_nr_getgid,regs);
  909. Linuxerror:=errno;
  910. end;
  911. Function GetEGid:Longint;
  912. {
  913. Get _effective_ Group ID.
  914. }
  915. var
  916. regs : SysCallregs;
  917. begin
  918. GetEgid:=SysCall(SysCall_nr_getegid,regs);
  919. Linuxerror:=errno;
  920. end;
  921. {******************************************************************************
  922. Date and Time related calls
  923. ******************************************************************************}
  924. Const
  925. {Date Translation}
  926. C1970=2440588;
  927. D0 = 1461;
  928. D1 = 146097;
  929. D2 =1721119;
  930. Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
  931. Var
  932. Century,XYear: LongInt;
  933. Begin
  934. If Month<=2 Then
  935. Begin
  936. Dec(Year);
  937. Inc(Month,12);
  938. End;
  939. Dec(Month,3);
  940. Century:=(longint(Year Div 100)*D1) shr 2;
  941. XYear:=(longint(Year Mod 100)*D0) shr 2;
  942. GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
  943. End;
  944. Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
  945. Var
  946. YYear,XYear,Temp : LongInt;
  947. Begin
  948. Temp:=((JulianDN-D2) shl 2)-1;
  949. JulianDN:=Temp Div D1;
  950. XYear:=(Temp Mod D1) or 3;
  951. YYear:=(XYear Div D0);
  952. Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
  953. Day:=((Temp Mod 153)+5) Div 5;
  954. Month:=Temp Div 153;
  955. If Month>=10 Then
  956. Begin
  957. inc(YYear);
  958. dec(Month,12);
  959. End;
  960. inc(Month,3);
  961. Year:=YYear+(JulianDN*100);
  962. end;
  963. Procedure GetTimeOfDay(var tv:timeval;var tz:timezone);
  964. {
  965. Get the time of day and timezone.
  966. }
  967. var
  968. regs : SysCallregs;
  969. begin
  970. regs.reg2:=longint(@tv);
  971. regs.reg3:=longint(@tz);
  972. SysCall(SysCall_nr_gettimeofday,regs);
  973. LinuxError:=Errno;
  974. end;
  975. Function GetTimeOfDay: longint;
  976. {
  977. Get the number of seconds since 00:00, January 1 1970, GMT
  978. the time NOT corrected any way
  979. }
  980. var
  981. t : timeval ;
  982. tz : timezone ;
  983. begin
  984. gettimeofday(t,tz);{Sets LinuxError also}
  985. GetTimeOfDay:=t.sec;
  986. end;
  987. Function GetEpochTime:longint;
  988. {
  989. Get the number of seconds since 00:00, January 1 1970, GMT
  990. the time is corrected according to the time zone, but NOT
  991. DST corrected.
  992. }
  993. var
  994. t : timeval ;
  995. tz : timezone ;
  996. begin
  997. gettimeofday(t,tz);{Sets LinuxError also}
  998. Getepochtime:=t.sec-tz.minuteswest*60;
  999. end;
  1000. Procedure InitEpochToLocal;
  1001. var
  1002. tv:TimeVal;
  1003. begin
  1004. GetTimeOfDay(tv,LocalTZ);
  1005. end;
  1006. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  1007. {
  1008. Transforms Epoch time(seconds since 00:00, january 1 1970, corrected for
  1009. local time zone) into local time (hour, minute,seconds)
  1010. }
  1011. Var
  1012. DateNum: LongInt;
  1013. Begin { Beginning of Localtime }
  1014. dec(Epoch,LocalTZ.minuteswest*60);
  1015. Datenum:=(Epoch Div 86400) + c1970;
  1016. JulianToGregorian(DateNum,Year,Month,day);
  1017. Epoch:=Epoch Mod 86400;
  1018. Hour:=Epoch Div 3600;
  1019. Epoch:=Epoch Mod 3600;
  1020. Minute:=Epoch Div 60;
  1021. Second:=Epoch Mod 60;
  1022. End;
  1023. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  1024. {
  1025. Transforms local time (year,month,day,hour,minutes,second) to Epoch time
  1026. (seconds since 00:00, january 1 1970, corrected for local time zone)
  1027. }
  1028. Begin
  1029. LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
  1030. (LongInt(Hour)*3600)+(Minute*60)+Second+(LocalTZ.minuteswest*60);
  1031. End;
  1032. Procedure GetTime(Var Hour,Minute,Second:Word);
  1033. {
  1034. Gets the current time, adjusted to local time, but not DST,
  1035. in hours, minutes and seconds.
  1036. }
  1037. var
  1038. year,day,month:Word;
  1039. Begin
  1040. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  1041. End;
  1042. Procedure GetDate(Var Year,Month,Day:Word);
  1043. {
  1044. Gets the current date, adjusted to local time, but not DST,
  1045. in year,month,day.
  1046. }
  1047. var
  1048. hour,minute,second : Word;
  1049. Begin
  1050. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  1051. End;
  1052. { The now following are for compatibility with earlier versions
  1053. of the linux unit... }
  1054. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Integer);
  1055. begin
  1056. EpochToLocal(epoch,word(year),word(month),word(day),word(hour),word(minute),word(second));
  1057. end;
  1058. Function LocalToEpoch(year,month,day,hour,minute,second:Integer):Longint;
  1059. begin
  1060. LocalToEpoch:=LocalToEpoch(word(year),word(month),word(day),word(hour),word(minute),word(second));
  1061. end;
  1062. Procedure GetTime(Var Hour,Minute,Second:Integer);
  1063. begin
  1064. GetTime(Word(Hour),Word(Minute),Word(Second));
  1065. end;
  1066. Procedure GetDate(Var Year,Month,Day:Integer);
  1067. begin
  1068. GetDate(Word(Year),Word(Month),Word(Day));
  1069. end;
  1070. {******************************************************************************
  1071. FileSystem calls
  1072. ******************************************************************************}
  1073. Function fdOpen(pathname:string;flags:longint):longint;
  1074. begin
  1075. pathname:=pathname+#0;
  1076. fdOpen:=Sys_Open(@pathname[1],flags,0);
  1077. LinuxError:=Errno;
  1078. end;
  1079. Function fdOpen(pathname:string;flags,mode:longint):longint;
  1080. begin
  1081. pathname:=pathname+#0;
  1082. fdOpen:=Sys_Open(@pathname[1],flags,mode);
  1083. LinuxError:=Errno;
  1084. end;
  1085. Function fdOpen(pathname:pchar;flags:longint):longint;
  1086. begin
  1087. fdOpen:=Sys_Open(pathname,flags,0);
  1088. LinuxError:=Errno;
  1089. end;
  1090. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  1091. begin
  1092. fdOpen:=Sys_Open(pathname,flags,mode);
  1093. LinuxError:=Errno;
  1094. end;
  1095. Function fdClose(fd:longint):boolean;
  1096. begin
  1097. fdClose:=(Sys_Close(fd)=0);
  1098. LinuxError:=Errno;
  1099. end;
  1100. Function fdRead(fd:longint;var buf;size:longint):longint;
  1101. begin
  1102. fdRead:=Sys_Read(fd,pchar(@buf),size);
  1103. LinuxError:=Errno;
  1104. end;
  1105. Function fdWrite(fd:longint;var buf;size:longint):longint;
  1106. begin
  1107. fdWrite:=Sys_Write(fd,pchar(@buf),size);
  1108. LinuxError:=Errno;
  1109. end;
  1110. Function fdTruncate(fd,size:longint):boolean;
  1111. var
  1112. Regs : SysCallRegs;
  1113. begin
  1114. Regs.reg2:=fd;
  1115. Regs.reg3:=size;
  1116. fdTruncate:=(SysCall(Syscall_nr_ftruncate,regs)=0);
  1117. LinuxError:=Errno;
  1118. end;
  1119. Function fdSeek (fd,pos,seektype :longint): longint;
  1120. {
  1121. Do a Seek on a file descriptor fd to position pos, starting from seektype
  1122. }
  1123. begin
  1124. fdseek:=Sys_LSeek (fd,pos,seektype);
  1125. LinuxError:=Errno;
  1126. end;
  1127. Function fdFlush (fd : Longint) : Boolean;
  1128. var
  1129. SR: SysCallRegs;
  1130. begin
  1131. SR.reg2 := fd;
  1132. fdFlush := (SysCall(syscall_nr_fsync, SR)=0);
  1133. LinuxError:=Errno;
  1134. end;
  1135. Function Fcntl(Fd:Text;Cmd:integer):integer;
  1136. {
  1137. Read or manipulate a file.(See also fcntl (2) )
  1138. Possible values for Cmd are :
  1139. F_GetFd,F_GetFl,F_GetOwn
  1140. Errors are reported in Linuxerror;
  1141. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  1142. }
  1143. var
  1144. sr : Syscallregs;
  1145. begin
  1146. if (cmd in [F_GetFd,F_GetFl,F_GetOwn]) then
  1147. begin
  1148. sr.reg2:=textrec(fd).handle;
  1149. sr.reg3:=cmd;
  1150. Linuxerror:=SysCall(Syscall_nr_fcntl,sr);
  1151. if linuxerror=-1 then
  1152. begin
  1153. linuxerror:=errno;
  1154. fcntl:=0;
  1155. end
  1156. else
  1157. begin
  1158. fcntl:=linuxerror;
  1159. linuxerror:=0;
  1160. end;
  1161. end
  1162. else
  1163. begin
  1164. linuxerror:=Sys_einval;
  1165. Fcntl:=0;
  1166. end;
  1167. end;
  1168. Procedure Fcntl(Fd:Text;Cmd:Integer;Arg:Longint);
  1169. {
  1170. Read or manipulate a file. (See also fcntl (2) )
  1171. Possible values for Cmd are :
  1172. F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
  1173. Errors are reported in Linuxerror;
  1174. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  1175. F_DupFD is not allowed, due to the structure of Files in Pascal.
  1176. }
  1177. var
  1178. sr : Syscallregs;
  1179. begin
  1180. if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn]) then
  1181. begin
  1182. sr.reg2:=textrec(fd).handle;
  1183. sr.reg3:=cmd;
  1184. sr.reg4:=arg;
  1185. SysCall(Syscall_nr_fcntl,sr);
  1186. linuxerror:=errno;
  1187. end
  1188. else
  1189. linuxerror:=Sys_einval;
  1190. end;
  1191. Function Chmod(path:pathstr;Newmode:longint):Boolean;
  1192. {
  1193. Changes the permissions of a file.
  1194. }
  1195. var
  1196. sr : Syscallregs;
  1197. begin
  1198. path:=path+#0;
  1199. sr.reg2:=longint(@(path[1]));
  1200. sr.reg3:=newmode;
  1201. Chmod:=(SysCall(Syscall_nr_chmod,sr)=0);
  1202. linuxerror:=errno;
  1203. end;
  1204. Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
  1205. {
  1206. Change the owner and group of a file.
  1207. A user can only change the group to a group of which he is a member.
  1208. The super-user can change uid and gid of any file.
  1209. }
  1210. var
  1211. sr : Syscallregs;
  1212. begin
  1213. path:=path+#0;
  1214. sr.reg2:=longint(@(path[1]));
  1215. sr.reg3:=newuid;
  1216. sr.reg4:=newgid;
  1217. ChOwn:=(Syscall(Syscall_nr_chown,sr)=0);
  1218. linuxerror:=errno;
  1219. end;
  1220. Function Utime(path:pathstr;utim:utimbuf):boolean;
  1221. var
  1222. sr : Syscallregs;
  1223. begin
  1224. path:=path+#0;
  1225. sr.reg2:=longint(@(path[1]));
  1226. sr.reg3:=longint(@utim);
  1227. Utime:=SysCall(Syscall_nr_utime,sr)=0;
  1228. linuxerror:=errno;
  1229. end;
  1230. Function Flock (fd,mode : longint) : boolean;
  1231. var sr : Syscallregs;
  1232. begin
  1233. sr.reg2:=fd;
  1234. sr.reg3:=mode;
  1235. flock:=Syscall(Syscall_nr_flock,sr)=0;
  1236. LinuxError:=errno;
  1237. end;
  1238. Function Flock (var T : text;mode : longint) : boolean;
  1239. begin
  1240. Flock:=Flock( TextRec(T).Handle,mode );
  1241. end;
  1242. Function Flock (var F : File;mode : longint) : boolean;
  1243. begin
  1244. Flock:=Flock(FileRec(F).Handle,mode);
  1245. end;
  1246. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  1247. {
  1248. Get all information on a file, and return it in Info.
  1249. }
  1250. begin
  1251. path:=path+#0;
  1252. FStat:=(Sys_stat(@(path[1]),Info)=0);
  1253. LinuxError:=errno;
  1254. end;
  1255. Function Fstat(Fd:Longint;var Info:stat):Boolean;
  1256. {
  1257. Get all information on a file descriptor, and return it in info.
  1258. }
  1259. var
  1260. regs : SysCallregs;
  1261. begin
  1262. regs.reg2:=Fd;
  1263. regs.reg3:=longint(@Info);
  1264. FStat:=(SysCall(SysCall_nr_fstat,regs)=0);
  1265. LinuxError:=Errno;
  1266. end;
  1267. Function FStat(var F:Text;Var Info:stat):Boolean;
  1268. {
  1269. Get all information on a text file, and return it in info.
  1270. }
  1271. begin
  1272. FStat:=Fstat(TextRec(F).Handle,INfo);
  1273. end;
  1274. Function FStat(var F:File;Var Info:stat):Boolean;
  1275. {
  1276. Get all information on a untyped file, and return it in info.
  1277. }
  1278. begin
  1279. FStat:=Fstat(FileRec(F).Handle,Info);
  1280. end;
  1281. Function Lstat(Filename: PathStr;var Info:stat):Boolean;
  1282. {
  1283. Get all information on a link (the link itself), and return it in info.
  1284. }
  1285. var
  1286. regs : SysCallregs;
  1287. begin
  1288. FileName:=FileName+#0;
  1289. regs.reg2:=longint(@filename[1]);
  1290. regs.reg3:=longint(@Info);
  1291. LStat:=(SysCall(SysCall_nr_lstat,regs)=0);
  1292. LinuxError:=Errno;
  1293. end;
  1294. Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
  1295. {
  1296. Get all information on a fileSystem, and return it in Info.
  1297. Path is the name of a file/directory on the fileSystem you wish to
  1298. investigate.
  1299. }
  1300. var
  1301. regs : SysCallregs;
  1302. begin
  1303. path:=path+#0;
  1304. regs.reg2:=longint(@path[1]);
  1305. regs.reg3:=longint(@Info);
  1306. FSStat:=(SysCall(SysCall_nr_statfs,regs)=0);
  1307. LinuxError:=errno;
  1308. end;
  1309. Function FSStat(Fd:Longint;Var Info:statfs):Boolean;
  1310. {
  1311. Get all information on a fileSystem, and return it in Info.
  1312. Fd is the file descriptor of a file/directory on the fileSystem
  1313. you wish to investigate.
  1314. }
  1315. var
  1316. regs : SysCallregs;
  1317. begin
  1318. regs.reg2:=Fd;
  1319. regs.reg3:=longint(@Info);
  1320. FSStat:=(SysCall(SysCall_nr_fstatfs,regs)=0);
  1321. LinuxError:=errno;
  1322. end;
  1323. Function Link(OldPath,NewPath:pathstr):boolean;
  1324. {
  1325. Proceduces a hard link from new to old.
  1326. In effect, new will be the same file as old.
  1327. }
  1328. var
  1329. regs : SysCallregs;
  1330. begin
  1331. oldpath:=oldpath+#0;
  1332. newpath:=newpath+#0;
  1333. regs.reg2:=longint(@oldpath[1]);
  1334. regs.reg3:=longint(@newpath[1]);
  1335. Link:=SysCall(SysCall_nr_link,regs)=0;
  1336. linuxerror:=errno;
  1337. end;
  1338. Function SymLink(OldPath,newPath:pathstr):boolean;
  1339. {
  1340. Proceduces a soft link from new to old.
  1341. }
  1342. begin
  1343. oldpath:=oldpath+#0;
  1344. newpath:=newpath+#0;
  1345. Symlink:=Sys_symlink(pchar(@(oldpath[1])),pchar(@(newpath[1])))=0;
  1346. linuxerror:=errno;
  1347. end;
  1348. Function UnLink(Path:pathstr):boolean;
  1349. {
  1350. Removes the file in 'Path' (that is, it decreases the link count with one.
  1351. if the link count is zero, the file is removed from the disk.
  1352. }
  1353. begin
  1354. path:=path+#0;
  1355. Unlink:=Sys_unlink(pchar(@(path[1])))=0;
  1356. linuxerror:=errno;
  1357. end;
  1358. Function UnLink(Path:pchar):Boolean;
  1359. {
  1360. Removes the file in 'Path' (that is, it decreases the link count with one.
  1361. if the link count is zero, the file is removed from the disk.
  1362. }
  1363. begin
  1364. Unlink:=(Sys_unlink(path)=0);
  1365. linuxerror:=errno;
  1366. end;
  1367. Function Umask(Mask:Integer):integer;
  1368. {
  1369. Sets file creation mask to (Mask and 0777 (octal) ), and returns the
  1370. previous value.
  1371. }
  1372. var
  1373. sr : Syscallregs;
  1374. begin
  1375. sr.reg2:=mask;
  1376. Umask:=SysCall(Syscall_nr_umask,sr);
  1377. linuxerror:=0;
  1378. end;
  1379. Function Access(Path:Pathstr ;mode:integer):boolean;
  1380. {
  1381. Test users access rights on the specified file.
  1382. Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
  1383. R,W,X stand for read,write and Execute access, simultaneously.
  1384. F_OK checks whether the test would be allowed on the file.
  1385. i.e. It checks the search permissions in all directory components
  1386. of the path.
  1387. The test is done with the real user-ID, instead of the effective.
  1388. If access is denied, or an error occurred, false is returned.
  1389. If access is granted, true is returned.
  1390. Errors other than no access,are reported in linuxerror.
  1391. }
  1392. var
  1393. sr : Syscallregs;
  1394. begin
  1395. path:=path+#0;
  1396. sr.reg2:=longint(@(path[1]));
  1397. sr.reg3:=mode;
  1398. access:=(SysCall(Syscall_nr_access,sr)=0);
  1399. linuxerror:=errno;
  1400. end;
  1401. Function Dup(oldfile,newfile:longint):Boolean;
  1402. {
  1403. Copies the filedescriptor oldfile to newfile
  1404. }
  1405. var
  1406. sr : Syscallregs;
  1407. begin
  1408. sr.reg2:=oldfile;
  1409. newfile:=Syscall(Syscall_nr_dup,sr);
  1410. linuxerror:=errno;
  1411. Dup:=(LinuxError=0);
  1412. end;
  1413. Function Dup(var oldfile,newfile:text):Boolean;
  1414. {
  1415. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  1416. oldfile.
  1417. After which the two textfiles are, in effect, the same, except
  1418. that they don't share the same buffer, and don't share the same
  1419. close_on_exit flag.
  1420. }
  1421. begin
  1422. flush(oldfile);{ We cannot share buffers, so we flush them. }
  1423. textrec(newfile):=textrec(oldfile);
  1424. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  1425. Dup:=Dup(textrec(oldfile).handle,textrec(newfile).handle);
  1426. end;
  1427. Function Dup(var oldfile,newfile:file):Boolean;
  1428. {
  1429. Copies the filedescriptor oldfile to newfile
  1430. }
  1431. begin
  1432. filerec(newfile):=filerec(oldfile);
  1433. Dup:=Dup(filerec(oldfile).handle,filerec(newfile).handle);
  1434. end;
  1435. Function Dup2(oldfile,newfile:longint):Boolean;
  1436. {
  1437. Copies the filedescriptor oldfile to newfile
  1438. }
  1439. var
  1440. sr : Syscallregs;
  1441. begin
  1442. sr.reg2:=oldfile;
  1443. sr.reg3:=newfile;
  1444. SysCall(Syscall_nr_dup2,sr);
  1445. linuxerror:=errno;
  1446. Dup2:=(LinuxError=0);
  1447. end;
  1448. Function Dup2(var oldfile,newfile:text):Boolean;
  1449. {
  1450. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  1451. oldfile. It closes newfile if it was still open.
  1452. After which the two textfiles are, in effect, the same, except
  1453. that they don't share the same buffer, and don't share the same
  1454. close_on_exit flag.
  1455. }
  1456. var
  1457. tmphandle : word;
  1458. begin
  1459. flush(oldfile);{ We cannot share buffers, so we flush them. }
  1460. flush(newfile);
  1461. tmphandle:=textrec(newfile).handle;
  1462. textrec(newfile):=textrec(oldfile);
  1463. textrec(newfile).handle:=tmphandle;
  1464. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  1465. Dup2:=Dup2(textrec(oldfile).handle,textrec(newfile).handle);
  1466. end;
  1467. Function Dup2(var oldfile,newfile:file):Boolean;
  1468. {
  1469. Copies the filedescriptor oldfile to newfile
  1470. }
  1471. begin
  1472. filerec(newfile):=filerec(oldfile);
  1473. Dup2:=Dup2(filerec(oldfile).handle,filerec(newfile).handle);
  1474. end;
  1475. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
  1476. {
  1477. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  1478. have changed.
  1479. }
  1480. Var
  1481. SelectArray : Array[1..5] of longint;
  1482. Sr : Syscallregs;
  1483. begin
  1484. SelectArray[1]:=n;
  1485. SelectArray[2]:=longint(Readfds);
  1486. Selectarray[3]:=longint(Writefds);
  1487. selectarray[4]:=longint(exceptfds);
  1488. Selectarray[5]:=longint(TimeOut);
  1489. sr.reg2:=longint(@selectarray);
  1490. Select:=SysCall(Syscall_nr_select,sr);
  1491. LinuxError:=Errno;
  1492. end;
  1493. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  1494. {
  1495. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  1496. have changed.
  1497. This function allows specification of a timeout as a longint.
  1498. }
  1499. var
  1500. p : PTimeVal;
  1501. tv : TimeVal;
  1502. begin
  1503. if TimeOut=-1 then
  1504. p:=nil
  1505. else
  1506. begin
  1507. tv.Sec:=Timeout div 1000;
  1508. tv.Usec:=(Timeout mod 1000)*1000;
  1509. p:=@tv;
  1510. end;
  1511. Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
  1512. end;
  1513. Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
  1514. Var
  1515. F:FDSet;
  1516. begin
  1517. if textrec(t).mode=fmclosed then
  1518. begin
  1519. LinuxError:=Sys_EBADF;
  1520. exit(-1);
  1521. end;
  1522. FD_Zero(f);
  1523. FD_Set(textrec(T).handle,f);
  1524. if textrec(T).mode=fminput then
  1525. SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
  1526. else
  1527. SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
  1528. end;
  1529. {******************************************************************************
  1530. Directory
  1531. ******************************************************************************}
  1532. Function OpenDir(F:String):PDir;
  1533. begin
  1534. F:=F+#0;
  1535. OpenDir:=OpenDir(@F[1]);
  1536. end;
  1537. procedure SeekDir(p:pdir;off:longint);
  1538. begin
  1539. if p=nil then
  1540. begin
  1541. errno:=Sys_EBADF;
  1542. exit;
  1543. end;
  1544. p^.nextoff:=Sys_lseek(p^.fd,off,seek_set);
  1545. p^.size:=0;
  1546. p^.loc:=0;
  1547. end;
  1548. function TellDir(p:pdir):longint;
  1549. begin
  1550. if p=nil then
  1551. begin
  1552. errno:=Sys_EBADF;
  1553. telldir:=-1;
  1554. exit;
  1555. end;
  1556. telldir:=Sys_lseek(p^.fd,0,seek_cur)
  1557. { We could try to use the nextoff field here, but on my 1.2.13
  1558. kernel, this gives nothing... This may have to do with
  1559. the readdir implementation of libc... I also didn't find any trace of
  1560. the field in the kernel code itself, So I suspect it is an artifact of libc.
  1561. Michael. }
  1562. end;
  1563. Function ReadDir(P:pdir):pdirent;
  1564. begin
  1565. ReadDir:=Sys_ReadDir(p);
  1566. LinuxError:=Errno;
  1567. end;
  1568. {******************************************************************************
  1569. Pipes/Fifo
  1570. ******************************************************************************}
  1571. Procedure OpenPipe(var F:Text);
  1572. begin
  1573. case textrec(f).mode of
  1574. fmoutput : if textrec(f).userdata[1]<>P_OUT then
  1575. textrec(f).mode:=fmclosed;
  1576. fminput : if textrec(f).userdata[1]<>P_IN then
  1577. textrec(f).mode:=fmclosed;
  1578. else
  1579. textrec(f).mode:=fmclosed;
  1580. end;
  1581. end;
  1582. Procedure IOPipe(var F:text);
  1583. begin
  1584. case textrec(f).mode of
  1585. fmoutput : Sys_write(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
  1586. fminput : textrec(f).bufend:=Sys_read(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
  1587. end;
  1588. textrec(f).bufpos:=0;
  1589. end;
  1590. Procedure FlushPipe(var F:Text);
  1591. begin
  1592. if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
  1593. IOPipe(f);
  1594. textrec(f).bufpos:=0;
  1595. end;
  1596. Procedure ClosePipe(var F:text);
  1597. begin
  1598. textrec(f).mode:=fmclosed;
  1599. Sys_close(textrec(f).handle);
  1600. end;
  1601. Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
  1602. {
  1603. Sets up a pair of file variables, which act as a pipe. The first one can
  1604. be read from, the second one can be written to.
  1605. If the operation was unsuccesful, linuxerror is set.
  1606. }
  1607. var
  1608. pip : tpipe;
  1609. regs : SysCallregs;
  1610. begin
  1611. regs.reg2:=longint(@pip);
  1612. SysCall(SysCall_nr_pipe,regs);
  1613. pipe_in:=pip[1];
  1614. pipe_out:=pip[2];
  1615. linuxerror:=errno;
  1616. AssignPipe:=(LinuxError=0);
  1617. end;
  1618. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  1619. {
  1620. Sets up a pair of file variables, which act as a pipe. The first one can
  1621. be read from, the second one can be written to.
  1622. If the operation was unsuccesful, linuxerror is set.
  1623. }
  1624. var
  1625. f_in,f_out : longint;
  1626. begin
  1627. if not AssignPipe(f_in,f_out) then
  1628. begin
  1629. AssignPipe:=false;
  1630. exit;
  1631. end;
  1632. { Set up input }
  1633. Assign(Pipe_in,'.');
  1634. Textrec(Pipe_in).Handle:=f_in;
  1635. Textrec(Pipe_in).Mode:=fmInput;
  1636. Textrec(Pipe_in).userdata[1]:=P_IN;
  1637. TextRec(Pipe_in).OpenFunc:=@OpenPipe;
  1638. TextRec(Pipe_in).InOutFunc:=@IOPipe;
  1639. TextRec(Pipe_in).FlushFunc:=@FlushPipe;
  1640. TextRec(Pipe_in).CloseFunc:=@ClosePipe;
  1641. { Set up output }
  1642. Assign(Pipe_out,'.');
  1643. Textrec(Pipe_out).Handle:=f_out;
  1644. Textrec(Pipe_out).Mode:=fmOutput;
  1645. Textrec(Pipe_out).userdata[1]:=P_OUT;
  1646. TextRec(Pipe_out).OpenFunc:=@OpenPipe;
  1647. TextRec(Pipe_out).InOutFunc:=@IOPipe;
  1648. TextRec(Pipe_out).FlushFunc:=@FlushPipe;
  1649. TextRec(Pipe_out).CloseFunc:=@ClosePipe;
  1650. AssignPipe:=true;
  1651. end;
  1652. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  1653. {
  1654. Sets up a pair of file variables, which act as a pipe. The first one can
  1655. be read from, the second one can be written to.
  1656. If the operation was unsuccesful, linuxerror is set.
  1657. }
  1658. var
  1659. f_in,f_out : longint;
  1660. begin
  1661. if not AssignPipe(f_in,f_out) then
  1662. begin
  1663. AssignPipe:=false;
  1664. exit;
  1665. end;
  1666. { Set up input }
  1667. Assign(Pipe_in,'.');
  1668. Filerec(Pipe_in).Handle:=f_in;
  1669. Filerec(Pipe_in).Mode:=fmInput;
  1670. Filerec(Pipe_in).recsize:=1;
  1671. Filerec(Pipe_in).userdata[1]:=P_IN;
  1672. { Set up output }
  1673. Assign(Pipe_out,'.');
  1674. Filerec(Pipe_out).Handle:=f_out;
  1675. Filerec(Pipe_out).Mode:=fmoutput;
  1676. Filerec(Pipe_out).recsize:=1;
  1677. Filerec(Pipe_out).userdata[1]:=P_OUT;
  1678. AssignPipe:=true;
  1679. end;
  1680. Function PClose(Var F:text) :longint;
  1681. var
  1682. sr : syscallregs;
  1683. pl : ^longint;
  1684. res : longint;
  1685. begin
  1686. sr.reg2:=Textrec(F).Handle;
  1687. SysCall (syscall_nr_close,sr);
  1688. { closed our side, Now wait for the other - this appears to be needed ?? }
  1689. pl:=@(textrec(f).userdata[2]);
  1690. waitpid(pl^,@res,0);
  1691. pclose:=res shr 8;
  1692. end;
  1693. Function PClose(Var F:file) : longint;
  1694. var
  1695. sr : syscallregs;
  1696. pl : ^longint;
  1697. res : longint;
  1698. begin
  1699. sr.reg2:=FileRec(F).Handle;
  1700. SysCall (Syscall_nr_close,sr);
  1701. { closed our side, Now wait for the other - this appears to be needed ?? }
  1702. pl:=@(filerec(f).userdata[2]);
  1703. waitpid(pl^,@res,0);
  1704. pclose:=res shr 8;
  1705. end;
  1706. Procedure PCloseText(Var F:text);
  1707. {
  1708. May not use @PClose due overloading
  1709. }
  1710. begin
  1711. PClose(f);
  1712. end;
  1713. Procedure POpen(var F:text;const Prog:String;rw:char);
  1714. {
  1715. Starts the program in 'Prog' and makes it's input or out put the
  1716. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  1717. F, will be read from stdin by the program in 'Prog'. The inverse is true
  1718. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  1719. read from 'f'.
  1720. }
  1721. var
  1722. pipi,
  1723. pipo : text;
  1724. pid : longint;
  1725. pl : ^longint;
  1726. pp : ppchar;
  1727. begin
  1728. LinuxError:=0;
  1729. rw:=upcase(rw);
  1730. if not (rw in ['R','W']) then
  1731. begin
  1732. LinuxError:=Sys_enoent;
  1733. exit;
  1734. end;
  1735. AssignPipe(pipi,pipo);
  1736. if Linuxerror<>0 then
  1737. exit;
  1738. pid:=fork;
  1739. if linuxerror<>0 then
  1740. begin
  1741. close(pipi);
  1742. close(pipo);
  1743. exit;
  1744. end;
  1745. if pid=0 then
  1746. begin
  1747. { We're in the child }
  1748. if rw='W' then
  1749. begin
  1750. close(pipo);
  1751. dup2(pipi,input);
  1752. close(pipi);
  1753. if linuxerror<>0 then
  1754. halt(127);
  1755. end
  1756. else
  1757. begin
  1758. close(pipi);
  1759. dup2(pipo,output);
  1760. close(pipo);
  1761. if linuxerror<>0 then
  1762. halt(127);
  1763. end;
  1764. pp:=createshellargv(prog);
  1765. Execve(pp^,pp,envp);
  1766. halt(127);
  1767. end
  1768. else
  1769. begin
  1770. { We're in the parent }
  1771. if rw='W' then
  1772. begin
  1773. close(pipi);
  1774. f:=pipo;
  1775. textrec(f).bufptr:=@textrec(f).buffer;
  1776. end
  1777. else
  1778. begin
  1779. close(pipo);
  1780. f:=pipi;
  1781. textrec(f).bufptr:=@textrec(f).buffer;
  1782. end;
  1783. {Save the process ID - needed when closing }
  1784. pl:=@(textrec(f).userdata[2]);
  1785. pl^:=pid;
  1786. textrec(f).closefunc:=@PCloseText;
  1787. end;
  1788. end;
  1789. Procedure POpen(var F:file;const Prog:String;rw:char);
  1790. {
  1791. Starts the program in 'Prog' and makes it's input or out put the
  1792. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  1793. F, will be read from stdin by the program in 'Prog'. The inverse is true
  1794. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  1795. read from 'f'.
  1796. }
  1797. var
  1798. pipi,
  1799. pipo : file;
  1800. pid : longint;
  1801. pl : ^longint;
  1802. p,pp : ppchar;
  1803. temp : string[255];
  1804. begin
  1805. LinuxError:=0;
  1806. rw:=upcase(rw);
  1807. if not (rw in ['R','W']) then
  1808. begin
  1809. LinuxError:=Sys_enoent;
  1810. exit;
  1811. end;
  1812. AssignPipe(pipi,pipo);
  1813. if Linuxerror<>0 then
  1814. exit;
  1815. pid:=fork;
  1816. if linuxerror<>0 then
  1817. begin
  1818. close(pipi);
  1819. close(pipo);
  1820. exit;
  1821. end;
  1822. if pid=0 then
  1823. begin
  1824. { We're in the child }
  1825. if rw='W' then
  1826. begin
  1827. close(pipo);
  1828. dup2(filerec(pipi).handle,stdinputhandle);
  1829. close(pipi);
  1830. if linuxerror<>0 then
  1831. halt(127);
  1832. end
  1833. else
  1834. begin
  1835. close(pipi);
  1836. dup2(filerec(pipo).handle,stdoutputhandle);
  1837. close(pipo);
  1838. if linuxerror<>0 then
  1839. halt(127);
  1840. end;
  1841. getmem(pp,sizeof(pchar)*4);
  1842. temp:='/bin/sh'#0'-c'#0+prog+#0;
  1843. pp^:=@temp[1];
  1844. p:=pp+sizeof(pchar);
  1845. p^:=@temp[9];
  1846. p:=p+sizeof(pchar);
  1847. p^:=@temp[12];
  1848. p:=p+sizeof(pchar);
  1849. p^:=Nil;
  1850. Execve('/bin/sh',pp,envp);
  1851. halt(127);
  1852. end
  1853. else
  1854. begin
  1855. { We're in the parent }
  1856. if rw='W' then
  1857. begin
  1858. close(pipi);
  1859. f:=pipo;
  1860. end
  1861. else
  1862. begin
  1863. close(pipo);
  1864. f:=pipi;
  1865. end;
  1866. {Save the process ID - needed when closing }
  1867. pl:=@(filerec(f).userdata[2]);
  1868. pl^:=pid;
  1869. end;
  1870. end;
  1871. Function mkFifo(pathname:string;mode:longint):boolean;
  1872. var
  1873. regs : SysCallRegs;
  1874. begin
  1875. pathname:=pathname+#0;
  1876. regs.reg2:=longint(@pathname[1]);
  1877. regs.reg3:=mode or STAT_IFIFO;
  1878. regs.reg4:=0;
  1879. mkFifo:=(SysCall(syscall_nr_mknod,regs)=0);
  1880. end;
  1881. Procedure AssignStream(Var StreamIn,Streamout:text;Const Prog:String);
  1882. {
  1883. Starts the program in 'Prog' and makes its input and output the
  1884. other end of two pipes, which are the stdin and stdout of a program
  1885. specified in 'Prog'.
  1886. streamout can be used to write to the program, streamin can be used to read
  1887. the output of the program. See the following diagram :
  1888. Parent Child
  1889. STreamout --> Input
  1890. Streamin <-- Output
  1891. }
  1892. var
  1893. pipi,
  1894. pipo : text;
  1895. pid : longint;
  1896. begin
  1897. LinuxError:=0;
  1898. AssignPipe(streamin,pipo);
  1899. if Linuxerror<>0 then
  1900. exit;
  1901. AssignPipe(pipi,streamout);
  1902. if Linuxerror<>0 then
  1903. exit;
  1904. pid:=fork;
  1905. if linuxerror<>0 then
  1906. begin
  1907. close(pipi);
  1908. close(pipo);
  1909. close (streamin);
  1910. close (streamout);
  1911. exit;
  1912. end;
  1913. if pid=0 then
  1914. begin
  1915. { We're in the child }
  1916. { Close what we don't need }
  1917. close(streamout);
  1918. close(streamin);
  1919. dup2(pipi,input);
  1920. if linuxerror<>0 then
  1921. halt(127);
  1922. close(pipi);
  1923. dup2(pipo,output);
  1924. if linuxerror<>0 then
  1925. halt (127);
  1926. close(pipo);
  1927. Execl(Prog);
  1928. halt(127);
  1929. end
  1930. else
  1931. begin
  1932. { we're in the parent}
  1933. {
  1934. Let's redraw the schedule :
  1935. Parent Child
  1936. pipo[1] --> pipi[1]
  1937. pipi[0] <-- pipo[0]
  1938. }
  1939. close(pipo);
  1940. // dup(pipi[0],streamin);
  1941. // close (pipi[0]);
  1942. close(pipi);
  1943. // dup(pipo[1],streamout);
  1944. // close (pipo[1]);
  1945. end;
  1946. end;
  1947. {******************************************************************************
  1948. General information calls
  1949. ******************************************************************************}
  1950. Function Sysinfo(var Info:TSysinfo):Boolean;
  1951. {
  1952. Get system info
  1953. }
  1954. var
  1955. regs : SysCallregs;
  1956. Begin
  1957. regs.reg2:=longint(@info);
  1958. Sysinfo:=SysCall(SysCall_nr_Sysinfo,regs)=0;
  1959. End;
  1960. Function Uname(var unamerec:utsname):Boolean;
  1961. {
  1962. Get machine's names
  1963. }
  1964. var
  1965. regs : SysCallregs;
  1966. Begin
  1967. regs.reg2:=longint(@unamerec);
  1968. Uname:=SysCall(SysCall_nr_uname,regs)=0;
  1969. LinuxError:=Errno;
  1970. End;
  1971. Function GetEnv(P:string):Pchar;
  1972. {
  1973. Searches the environment for a string with name p and
  1974. returns a pchar to it's value.
  1975. A pchar is used to accomodate for strings of length > 255
  1976. }
  1977. var
  1978. ep : ppchar;
  1979. found : boolean;
  1980. Begin
  1981. p:=p+'='; {Else HOST will also find HOSTNAME, etc}
  1982. ep:=envp;
  1983. found:=false;
  1984. while (not found) and (ep^<>nil) do
  1985. begin
  1986. if strlcomp(@p[1],(ep^),length(p))=0 then
  1987. found:=true
  1988. else
  1989. ep:=ep+4;
  1990. end;
  1991. if found then
  1992. getenv:=ep^+length(p)
  1993. else
  1994. getenv:=nil;
  1995. end;
  1996. Function GetDomainName:String;
  1997. {
  1998. Get machines domain name. Returns empty string if not set.
  1999. }
  2000. Var
  2001. Sysn : utsname;
  2002. begin
  2003. Uname(Sysn);
  2004. linuxerror:=errno;
  2005. If linuxerror<>0 then
  2006. getdomainname:=''
  2007. else
  2008. getdomainname:=strpas(@Sysn.domainname[0]);
  2009. end;
  2010. Function GetHostName:String;
  2011. {
  2012. Get machines name. Returns empty string if not set.
  2013. }
  2014. Var
  2015. Sysn : utsname;
  2016. begin
  2017. uname(Sysn);
  2018. linuxerror:=errno;
  2019. If linuxerror<>0 then
  2020. gethostname:=''
  2021. else
  2022. gethostname:=strpas(@Sysn.nodename[0]);
  2023. end;
  2024. {******************************************************************************
  2025. Signal handling calls
  2026. ******************************************************************************}
  2027. Function Kill(Pid:longint;Sig:integer):integer;
  2028. {
  2029. Send signal 'sig' to a process, or a group of processes.
  2030. If Pid > 0 then the signal is sent to pid
  2031. pid=-1 to all processes except process 1
  2032. pid < -1 to process group -pid
  2033. Return value is zero, except for case three, where the return value
  2034. is the number of processes to which the signal was sent.
  2035. }
  2036. var
  2037. regs : Syscallregs;
  2038. begin
  2039. regs.reg2:=Pid;
  2040. regs.reg3:=Sig;
  2041. kill:=SysCall(Syscall_nr_kill,regs);
  2042. if kill<0 then
  2043. Kill:=0;
  2044. linuxerror:=errno;
  2045. end;
  2046. Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
  2047. {
  2048. Change action of process upon receipt of a signal.
  2049. Signum specifies the signal (all except SigKill and SigStop).
  2050. If Act is non-nil, it is used to specify the new action.
  2051. If OldAct is non-nil the previous action is saved there.
  2052. }
  2053. Var
  2054. sr : Syscallregs;
  2055. begin
  2056. sr.reg2:=Signum;
  2057. sr.reg3:=Longint(act);
  2058. sr.reg4:=Longint(oldact);
  2059. SysCall(Syscall_nr_sigaction,sr);
  2060. linuxerror:=errno;
  2061. end;
  2062. Procedure SigProcMask(How:Integer;SSet,OldSSet:PSigSet);
  2063. {
  2064. Change the list of currently blocked signals.
  2065. How determines which signals will be blocked :
  2066. SigBlock : Add SSet to the current list of blocked signals
  2067. SigUnBlock : Remove the signals in SSet from the list of blocked signals.
  2068. SigSetMask : Set the list of blocked signals to SSet
  2069. if OldSSet is non-null, the old set will be saved there.
  2070. }
  2071. Var
  2072. sr : SyscallRegs;
  2073. begin
  2074. sr.reg2:=how;
  2075. sr.reg3:=longint(SSet);
  2076. sr.reg4:=longint(OldSSet);
  2077. SysCall(Syscall_nr_sigprocmask,sr);
  2078. linuxerror:=errno;
  2079. end;
  2080. Function SigPending:SigSet;
  2081. {
  2082. Allows examination of pending signals. The signal mask of pending
  2083. signals is set in SSet
  2084. }
  2085. Var
  2086. sr : SyscallRegs;
  2087. dummy : Sigset;
  2088. begin
  2089. sr.reg2:=longint(@dummy);
  2090. SysCall(Syscall_nr_sigpending,sr);
  2091. linuxerror:=errno;
  2092. Sigpending:=dummy;
  2093. end;
  2094. Procedure SigSuspend(Mask:Sigset);
  2095. {
  2096. Set the signal mask with Mask, and suspend the program until a signal
  2097. is received.
  2098. }
  2099. Var
  2100. sr : SyscallRegs;
  2101. begin
  2102. sr.reg2:=mask;
  2103. SysCall(Syscall_nr_sigsuspend,sr);
  2104. linuxerror:=errno;
  2105. end;
  2106. Function Signal(Signum:Integer;Handler:PSignalHandler):PSignalHandler;
  2107. {
  2108. Install a new handler for signal Signum.
  2109. The old signal handler is returned.
  2110. This call does, in fact, the same as SigAction.
  2111. }
  2112. var
  2113. sr : Syscallregs;
  2114. begin
  2115. sr.reg2:=signum;
  2116. sr.reg3:=longint(handler);
  2117. Linuxerror:=SysCall(Syscall_nr_signal,sr);
  2118. If linuxerror=Sig_Err then
  2119. begin
  2120. Signal:=nil;
  2121. Linuxerror:=errno;
  2122. end
  2123. else
  2124. begin
  2125. Signal:=pointer(Linuxerror);
  2126. linuxerror:=0;
  2127. end;
  2128. end;
  2129. {******************************************************************************
  2130. IOCtl and Termios calls
  2131. ******************************************************************************}
  2132. Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
  2133. {
  2134. Interface to Unix ioctl call.
  2135. Performs various operations on the filedescriptor Handle.
  2136. Ndx describes the operation to perform.
  2137. Data points to data needed for the Ndx function. The structure of this
  2138. data is function-dependent.
  2139. }
  2140. var
  2141. sr: SysCallRegs;
  2142. begin
  2143. sr.reg2:=Handle;
  2144. sr.reg3:=Ndx;
  2145. sr.reg4:=Longint(Data);
  2146. IOCtl:=(SysCall(Syscall_nr_ioctl,sr)=0);
  2147. LinuxError:=Errno;
  2148. end;
  2149. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  2150. begin
  2151. TCGetAttr:=IOCtl(fd,TCGETS,@tios);
  2152. end;
  2153. Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
  2154. var
  2155. nr:longint;
  2156. begin
  2157. case OptAct of
  2158. TCSANOW : nr:=TCSETS;
  2159. TCSADRAIN : nr:=TCSETSW;
  2160. TCSAFLUSH : nr:=TCSETSF;
  2161. else
  2162. begin
  2163. ErrNo:=Sys_EINVAL;
  2164. TCSetAttr:=false;
  2165. exit;
  2166. end;
  2167. end;
  2168. TCSetAttr:=IOCtl(fd,nr,@Tios);
  2169. end;
  2170. Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
  2171. begin
  2172. tios.c_cflag:=(tios.c_cflag and (not CBAUD)) or speed;
  2173. end;
  2174. Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
  2175. begin
  2176. CFSetISpeed(tios,speed);
  2177. end;
  2178. Procedure CFMakeRaw(var tios:TermIOS);
  2179. begin
  2180. with tios do
  2181. begin
  2182. c_iflag:=c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
  2183. INLCR or IGNCR or ICRNL or IXON));
  2184. c_oflag:=c_oflag and (not OPOST);
  2185. c_lflag:=c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
  2186. c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or CS8;
  2187. end;
  2188. end;
  2189. Function TCSendBreak(fd,duration:longint):boolean;
  2190. begin
  2191. TCSendBreak:=IOCtl(fd,TCSBRK,pointer(duration));
  2192. end;
  2193. Function TCSetPGrp(fd,id:longint):boolean;
  2194. begin
  2195. TCSetPGrp:=IOCtl(fd,TIOCSPGRP,pointer(id));
  2196. end;
  2197. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  2198. begin
  2199. TCGetPGrp:=IOCtl(fd,TIOCGPGRP,@id);
  2200. end;
  2201. Function TCDrain(fd:longint):boolean;
  2202. begin
  2203. TCDrain:=IOCtl(fd,TCSBRK,pointer(1));
  2204. end;
  2205. Function TCFlow(fd,act:longint):boolean;
  2206. begin
  2207. TCFlow:=IOCtl(fd,TCXONC,pointer(act));
  2208. end;
  2209. Function TCFlush(fd,qsel:longint):boolean;
  2210. begin
  2211. TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
  2212. end;
  2213. Function IsATTY(Handle:Longint):Boolean;
  2214. {
  2215. Check if the filehandle described by 'handle' is a TTY (Terminal)
  2216. }
  2217. var
  2218. t : Termios;
  2219. begin
  2220. IsAtty:=TCGetAttr(Handle,t);
  2221. end;
  2222. Function IsATTY(f: text):Boolean;
  2223. {
  2224. Idem as previous, only now for text variables.
  2225. }
  2226. begin
  2227. IsATTY:=IsaTTY(textrec(f).handle);
  2228. end;
  2229. function TTYName(Handle:Longint):string;
  2230. {
  2231. Return the name of the current tty described by handle f.
  2232. returns empty string in case of an error.
  2233. }
  2234. Const
  2235. dev='/dev';
  2236. var
  2237. name : string;
  2238. st : stat;
  2239. mydev,
  2240. myino : longint;
  2241. dirstream : pdir;
  2242. d : pdirent;
  2243. begin
  2244. TTYName:='';
  2245. fstat(handle,st);
  2246. if (errno<>0) and isatty (handle) then
  2247. exit;
  2248. mydev:=st.dev;
  2249. myino:=st.ino;
  2250. dirstream:=opendir(dev);
  2251. if (linuxerror<>0) then
  2252. exit;
  2253. d:=Readdir(dirstream);
  2254. while (d<>nil) do
  2255. begin
  2256. if (d^.ino=myino) then
  2257. begin
  2258. name:=dev+'/'+strpas(@(d^.name));
  2259. fstat(name,st);
  2260. if (linuxerror=0) and (st.dev=mydev) then
  2261. begin
  2262. closedir(dirstream);
  2263. ttyname:=name;
  2264. exit;
  2265. end;
  2266. end;
  2267. d:=Readdir(dirstream);
  2268. end;
  2269. closedir(dirstream);
  2270. end;
  2271. function TTYName(var F:Text):string;
  2272. {
  2273. Idem as previous, only now for text variables;
  2274. }
  2275. begin
  2276. TTYName:=TTYName(textrec(f).handle);
  2277. end;
  2278. {******************************************************************************
  2279. Utility calls
  2280. ******************************************************************************}
  2281. Function Octal(l:longint):longint;
  2282. {
  2283. Convert an octal specified number to decimal;
  2284. }
  2285. var
  2286. octnr,
  2287. oct : longint;
  2288. begin
  2289. octnr:=0;
  2290. oct:=0;
  2291. while (l>0) do
  2292. begin
  2293. oct:=oct or ((l mod 10) shl octnr);
  2294. l:=l div 10;
  2295. inc(octnr,3);
  2296. end;
  2297. Octal:=oct;
  2298. end;
  2299. Function StringToPPChar(Var S:STring):ppchar;
  2300. {
  2301. Create a PPChar to structure of pchars which are the arguments specified
  2302. in the string S. Especially usefull for creating an ArgV for Exec-calls
  2303. }
  2304. var
  2305. nr : longint;
  2306. Buf : ^char;
  2307. p : ppchar;
  2308. begin
  2309. s:=s+#0;
  2310. buf:=@s[1];
  2311. nr:=0;
  2312. while(buf^<>#0) do
  2313. begin
  2314. while (buf^ in [' ',#8,#10]) do
  2315. buf:=buf+1;
  2316. inc(nr);
  2317. while not (buf^ in [' ',#0,#8,#10]) do
  2318. buf:=buf+1;
  2319. end;
  2320. getmem(p,nr*4);
  2321. StringToPPChar:=p;
  2322. if p=nil then
  2323. begin
  2324. LinuxError:=sys_enomem;
  2325. exit;
  2326. end;
  2327. buf:=@s[1];
  2328. while (buf^<>#0) do
  2329. begin
  2330. while (buf^ in [' ',#8,#10]) do
  2331. begin
  2332. buf^:=#0;
  2333. buf:=buf+1;
  2334. end;
  2335. p^:=buf;
  2336. p:=p+4;
  2337. p^:=nil;
  2338. while not (buf^ in [' ',#0,#8,#10]) do
  2339. buf:=buf+1;
  2340. end;
  2341. end;
  2342. Function FExpand(Const Path:PathStr):PathStr;
  2343. var
  2344. temp : pathstr;
  2345. i,j : longint;
  2346. p : pchar;
  2347. Begin
  2348. {Remove eventual drive - doesn't exist in Linux}
  2349. if path[2]=':' then
  2350. i:=3
  2351. else
  2352. i:=1;
  2353. temp:='';
  2354. {Replace ~/ with $HOME}
  2355. if (path[i]='~') and ((i+1>length(path)) or (path[i+1]='/')) then
  2356. begin
  2357. p:=getenv('HOME');
  2358. if not (p=nil) then
  2359. Insert(StrPas(p),temp,i);
  2360. i:=1;
  2361. temp:=temp+Copy(Path,2,255);
  2362. end;
  2363. {Do we have an absolute path ? No - prefix the current dir}
  2364. if temp='' then
  2365. begin
  2366. if path[i]<>'/' then
  2367. getdir(0,temp)
  2368. else
  2369. inc(i);
  2370. temp:=temp+'/'+copy(path,i,length(path)-i+1)+'/';
  2371. end;
  2372. {First remove all references to '/./'}
  2373. while pos('/./',temp)<>0 do
  2374. delete(temp,pos('/./',temp),2);
  2375. {Now remove also all references to '/../' + of course previous dirs..}
  2376. repeat
  2377. i:=pos('/../',temp);
  2378. {Find the pos of the previous dir}
  2379. if i>1 then
  2380. begin
  2381. j:=i-1;
  2382. while (j>1) and (temp[j]<>'/') do
  2383. dec (j);{temp[1] is always '/'}
  2384. delete(temp,j,i-j+3);
  2385. end
  2386. else
  2387. if i=1 then {i=1, so we have temp='/../something', just delete '/../'}
  2388. delete(temp,1,3);
  2389. until i=0;
  2390. {Remove ending . and / which may exist}
  2391. if (length(temp)>0) and (temp[length(temp)]='/') then
  2392. dec(byte(temp[0]));
  2393. fexpand:=temp;
  2394. End;
  2395. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  2396. {
  2397. Searches for a file 'path' in the list of direcories in 'dirlist'.
  2398. returns an empty string if not found. Wildcards are NOT allowed.
  2399. If dirlist is empty, it is set to '.'
  2400. }
  2401. Var
  2402. NewDir : PathStr;
  2403. p1 : Longint;
  2404. Info : Stat;
  2405. Begin
  2406. {Replace ':' with ';'}
  2407. for p1:=1to length(dirlist) do
  2408. if dirlist[p1]=':' then
  2409. dirlist[p1]:=';';
  2410. {Check for WildCards}
  2411. If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
  2412. FSearch:='' {No wildcards allowed in these things.}
  2413. Else
  2414. Begin
  2415. Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
  2416. Repeat
  2417. p1:=Pos(';',DirList);
  2418. If p1=0 Then
  2419. p1:=255;
  2420. NewDir:=Copy(DirList,1,P1 - 1);
  2421. if NewDir[Length(NewDir)]<>'/' then
  2422. NewDir:=NewDir+'/';
  2423. NewDir:=NewDir+Path;
  2424. Delete(DirList,1,p1);
  2425. if FStat(NewDir,Info) then
  2426. Begin
  2427. If Pos('./',NewDir)=1 Then
  2428. Delete(NewDir,1,2);
  2429. {DOS strips off an initial .\}
  2430. End
  2431. Else
  2432. NewDir:='';
  2433. Until (DirList='') or (Length(NewDir) > 0);
  2434. FSearch:=NewDir;
  2435. End;
  2436. End;
  2437. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  2438. Var
  2439. DotPos,SlashPos,i : longint;
  2440. Begin
  2441. SlashPos:=0;
  2442. DotPos:=256;
  2443. i:=Length(Path);
  2444. While (i>0) and (SlashPos=0) Do
  2445. Begin
  2446. If (DotPos=256) and (Path[i]='.') Then
  2447. DotPos:=i;
  2448. If (Path[i]='/') Then
  2449. SlashPos:=i;
  2450. Dec(i);
  2451. End;
  2452. Ext:=Copy(Path,DotPos,255);
  2453. Dir:=Copy(Path,1,SlashPos);
  2454. Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
  2455. End;
  2456. Function Dirname(Const path:pathstr):pathstr;
  2457. {
  2458. This function returns the directory part of a complete path.
  2459. Unless the directory is root '/', The last character is not
  2460. a slash.
  2461. }
  2462. var
  2463. Dir,Name,Ext : string;
  2464. begin
  2465. FSplit(Path,Dir,Name,Ext);
  2466. if length(Dir)>1 then
  2467. Delete(Dir,length(Dir),1);
  2468. DirName:=Dir;
  2469. end;
  2470. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  2471. {
  2472. This function returns the filename part of a complete path. If suf is
  2473. supplied, it is cut off the filename.
  2474. }
  2475. var
  2476. Dir,Name,Ext : string;
  2477. begin
  2478. FSplit(Path,Dir,Name,Ext);
  2479. if Suf<>Ext then
  2480. Name:=Name+Ext;
  2481. BaseName:=Name;
  2482. end;
  2483. Function FNMatch(const Pattern,Name:string):Boolean;
  2484. Var
  2485. LenPat,LenName : longint;
  2486. Function DoFNMatch(i,j:longint):Boolean;
  2487. Var
  2488. Found : boolean;
  2489. Begin
  2490. Found:=true;
  2491. While Found and (i<=LenPat) Do
  2492. Begin
  2493. Case Pattern[i] of
  2494. '?' : Found:=(j<=LenName);
  2495. '*' : Begin
  2496. {find the next character in pattern, different of ? and *}
  2497. while Found and (i<LenPat) do
  2498. begin
  2499. inc(i);
  2500. case Pattern[i] of
  2501. '*' : ;
  2502. '?' : begin
  2503. inc(j);
  2504. Found:=(j<=LenName);
  2505. end;
  2506. else
  2507. Found:=false;
  2508. end;
  2509. end;
  2510. {Now, find in name the character which i points to, if the * or ?
  2511. wasn't the last character in the pattern, else, use up all the
  2512. chars in name}
  2513. Found:=true;
  2514. if (i<=LenPat) then
  2515. begin
  2516. repeat
  2517. {find a letter (not only first !) which maches pattern[i]}
  2518. while (j<=LenName) and (name[j]<>pattern[i]) do
  2519. inc (j);
  2520. if (j<LenName) then
  2521. begin
  2522. if DoFnMatch(i+1,j+1) then
  2523. begin
  2524. i:=LenPat;
  2525. j:=LenName;{we can stop}
  2526. Found:=true;
  2527. end
  2528. else
  2529. inc(j);{We didn't find one, need to look further}
  2530. end;
  2531. until (j>=LenName);
  2532. end
  2533. else
  2534. j:=LenName;{we can stop}
  2535. end;
  2536. else {not a wildcard character in pattern}
  2537. Found:=(j<=LenName) and (pattern[i]=name[j]);
  2538. end;
  2539. inc(i);
  2540. inc(j);
  2541. end;
  2542. DoFnMatch:=Found and (j>LenName);
  2543. end;
  2544. Begin {start FNMatch}
  2545. LenPat:=Length(Pattern);
  2546. LenName:=Length(Name);
  2547. FNMatch:=DoFNMatch(1,1);
  2548. End;
  2549. Procedure Globfree(var p : pglob);
  2550. {
  2551. Release memory occupied by pglob structure, and names in it.
  2552. sets p to nil.
  2553. }
  2554. var
  2555. temp : pglob;
  2556. begin
  2557. while p<>nil do
  2558. begin
  2559. temp:=p^.next;
  2560. if p^.name<>nil then
  2561. freemem(p^.name,strlen(p^.name));
  2562. dispose(p);
  2563. p:=temp;
  2564. end;
  2565. end;
  2566. Function Glob(Const path:pathstr):pglob;
  2567. {
  2568. Fills a tglob structure with entries matching path,
  2569. and returns a pointer to it. Returns nil on error,
  2570. linuxerror is set accordingly.
  2571. }
  2572. var
  2573. temp : string[255];
  2574. thedir : pdir;
  2575. buffer : pdirent;
  2576. root,run : pglob;
  2577. begin
  2578. { Get directory }
  2579. if dirname(path)='' then
  2580. temp:='.'
  2581. else
  2582. temp:=dirname(path);
  2583. temp:=temp+#0;
  2584. thedir:=opendir(@temp[1]);
  2585. if thedir=nil then
  2586. begin
  2587. glob:=nil;
  2588. linuxerror:=errno;
  2589. exit;
  2590. end;
  2591. temp:=basename(path,'');{ get the pattern }
  2592. if thedir^.fd<0 then
  2593. begin
  2594. linuxerror:=errno;
  2595. glob:=nil;
  2596. exit;
  2597. end;
  2598. {get the entries}
  2599. new(root);
  2600. run:=root;
  2601. repeat
  2602. buffer:=Sys_readdir(thedir);
  2603. if buffer<>nil then
  2604. begin
  2605. if fnmatch(temp,strpas(@(buffer^.name[0]))) then
  2606. begin
  2607. { get memory for pglob }
  2608. new(run^.next);
  2609. if run^.next=nil then
  2610. begin
  2611. linuxerror:=Sys_ENOMEM;
  2612. globfree(root);
  2613. glob:=nil;
  2614. exit;
  2615. end
  2616. else
  2617. begin
  2618. run:=run^.next;
  2619. run^.next:=nil;
  2620. end;
  2621. { Get memory for name }
  2622. getmem(run^.name,strlen(@(buffer^.name[0]))+1);
  2623. if run^.name=nil then
  2624. begin
  2625. linuxerror:=Sys_ENOMEM;
  2626. globfree(root);
  2627. glob:=nil;
  2628. exit;
  2629. end;
  2630. move(buffer^.name[0],run^.name^,strlen(@(buffer^.name[0]))+1);
  2631. end;{ if fnmatch }
  2632. end { buffer <> nil }
  2633. else
  2634. begin
  2635. run:=root;
  2636. if root^.next<>nil then
  2637. root:=root^.next;{ put root on first entry}
  2638. if run<>nil then
  2639. begin
  2640. run^.next:=nil;
  2641. globfree(run);
  2642. end;
  2643. end;
  2644. until buffer=nil;
  2645. if root^.name=nil then
  2646. begin
  2647. dispose(root);
  2648. linuxerror:=0;
  2649. glob:=nil;
  2650. end
  2651. else
  2652. glob:=root;
  2653. end;
  2654. {--------------------------------
  2655. FiledescriptorSets
  2656. --------------------------------}
  2657. Procedure FD_Zero(var fds:fdSet);
  2658. {
  2659. Clear the set of filedescriptors
  2660. }
  2661. begin
  2662. FillChar(fds,sizeof(fdSet),0);
  2663. end;
  2664. Procedure FD_Clr(fd:longint;var fds:fdSet);
  2665. {
  2666. Remove fd from the set of filedescriptors
  2667. }
  2668. begin
  2669. fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
  2670. end;
  2671. Procedure FD_Set(fd:longint;var fds:fdSet);
  2672. {
  2673. Add fd to the set of filedescriptors
  2674. }
  2675. begin
  2676. fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
  2677. end;
  2678. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  2679. {
  2680. Test if fd is part of the set of filedescriptors
  2681. }
  2682. begin
  2683. FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
  2684. end;
  2685. Function GetFS (var T:Text):longint;
  2686. {
  2687. Get File Descriptor of a text file.
  2688. }
  2689. begin
  2690. if textrec(t).mode=fmclosed then
  2691. exit(-1)
  2692. else
  2693. GETFS:=textrec(t).Handle
  2694. end;
  2695. Function GetFS(Var F:File):longint;
  2696. {
  2697. Get File Descriptor of an unTyped file.
  2698. }
  2699. begin
  2700. { Handle and mode are on the same place in textrec and filerec. }
  2701. if filerec(f).mode=fmclosed then
  2702. exit(-1)
  2703. else
  2704. GETFS:=filerec(f).Handle
  2705. end;
  2706. {--------------------------------
  2707. Stat.Mode Macro's
  2708. --------------------------------}
  2709. Function S_ISLNK(m:integer):boolean;
  2710. {
  2711. Check mode field of inode for link.
  2712. }
  2713. begin
  2714. S_ISLNK:=(m and STAT_IFMT)=STAT_IFLNK;
  2715. end;
  2716. Function S_ISREG(m:integer):boolean;
  2717. {
  2718. Check mode field of inode for regular file.
  2719. }
  2720. begin
  2721. S_ISREG:=(m and STAT_IFMT)=STAT_IFREG;
  2722. end;
  2723. Function S_ISDIR(m:integer):boolean;
  2724. {
  2725. Check mode field of inode for directory.
  2726. }
  2727. begin
  2728. S_ISDIR:=(m and STAT_IFMT)=STAT_IFDIR;
  2729. end;
  2730. Function S_ISCHR(m:integer):boolean;
  2731. {
  2732. Check mode field of inode for character device.
  2733. }
  2734. begin
  2735. S_ISCHR:=(m and STAT_IFMT)=STAT_IFCHR;
  2736. end;
  2737. Function S_ISBLK(m:integer):boolean;
  2738. {
  2739. Check mode field of inode for block device.
  2740. }
  2741. begin
  2742. S_ISBLK:=(m and STAT_IFMT)=STAT_IFBLK;
  2743. end;
  2744. Function S_ISFIFO(m:integer):boolean;
  2745. {
  2746. Check mode field of inode for named pipe (FIFO).
  2747. }
  2748. begin
  2749. S_ISFIFO:=(m and STAT_IFMT)=STAT_IFIFO;
  2750. end;
  2751. Function S_ISSOCK(m:integer):boolean;
  2752. {
  2753. Check mode field of inode for socket.
  2754. }
  2755. begin
  2756. S_ISSOCK:=(m and STAT_IFMT)=STAT_IFSOCK;
  2757. end;
  2758. {--------------------------------
  2759. Port IO functions
  2760. --------------------------------}
  2761. Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
  2762. {
  2763. Set permissions on NUM ports starting with port FROM to VALUE
  2764. this works ONLY as root.
  2765. }
  2766. Var Sr : Syscallregs;
  2767. begin
  2768. Sr.Reg2:=From;
  2769. Sr.Reg3:=Num;
  2770. Sr.Reg4:=Value;
  2771. IOPerm:=Syscall(Syscall_nr_ioperm,sr)=0;
  2772. LinuxError:=Errno;
  2773. end;
  2774. Procedure WritePort (Port : Longint; Value : Byte);
  2775. {
  2776. Writes 'Value' to port 'Port'
  2777. }
  2778. begin
  2779. asm
  2780. movl 8(%ebp),%edx
  2781. movb 12(%ebp),%al
  2782. outb %al,%dx
  2783. end;
  2784. end;
  2785. Procedure WritePort (Port : Longint; Value : Word);
  2786. {
  2787. Writes 'Value' to port 'Port'
  2788. }
  2789. begin
  2790. asm
  2791. movl 8(%ebp),%edx
  2792. movw 12(%ebp),%ax
  2793. outw %ax,%dx
  2794. end ['EAX','EBX'];
  2795. end;
  2796. Procedure WritePort (Port : Longint; Value : Longint);
  2797. {
  2798. Writes 'Value' to port 'Port'
  2799. }
  2800. begin
  2801. asm
  2802. movl 8(%ebp),%edx
  2803. movl 12(%ebp),%eax
  2804. outl %eax,%dx
  2805. end ['EAX','EBX'];
  2806. end;
  2807. Procedure WritePortl (Port : Longint; Var Buf; Count: longint);
  2808. {
  2809. Writes 'Count' longints from 'Buf' to Port
  2810. }
  2811. begin
  2812. asm
  2813. movl 16(%ebp),%ecx
  2814. movl 12(%ebp),%esi
  2815. movl 8(%ebp),%edx
  2816. cld
  2817. rep
  2818. outsl
  2819. end ['ECX','ESI','EDX'];
  2820. end;
  2821. Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
  2822. {
  2823. Writes 'Count' words from 'Buf' to Port
  2824. }
  2825. begin
  2826. asm
  2827. movl 16(%ebp),%ecx
  2828. movl 12(%ebp),%esi
  2829. movl 8(%ebp),%edx
  2830. cld
  2831. rep
  2832. outsw
  2833. end ['ECX','ESI','EDX'];
  2834. end;
  2835. Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
  2836. {
  2837. Writes 'Count' bytes from 'Buf' to Port
  2838. }
  2839. begin
  2840. asm
  2841. movl 16(%ebp),%ecx
  2842. movl 12(%ebp),%esi
  2843. movl 8(%ebp),%edx
  2844. cld
  2845. rep
  2846. outsb
  2847. end ['ECX','ESI','EDX'];
  2848. end;
  2849. Procedure ReadPort (Port : Longint; Var Value : Byte);
  2850. {
  2851. Reads 'Value' from port 'Port'
  2852. }
  2853. begin
  2854. asm
  2855. movl 8(%ebp),%edx
  2856. inb %dx,%al
  2857. andl $255,%eax
  2858. movl %eax,12(%ebp)
  2859. end ['EAX','EBX'];
  2860. end;
  2861. Procedure ReadPort (Port : Longint; Var Value : Word);
  2862. {
  2863. Reads 'Value' from port 'Port'
  2864. }
  2865. begin
  2866. asm
  2867. movl 8(%ebp),%edx
  2868. inw %dx,%ax
  2869. andl $65535,%eax
  2870. movl %eax,12(%ebp)
  2871. end ['EAX','EBX'];
  2872. end;
  2873. Procedure ReadPort (Port : Longint; Var Value : Longint);
  2874. {
  2875. Reads 'Value' from port 'Port'
  2876. }
  2877. begin
  2878. asm
  2879. movl 8(%ebp),%edx
  2880. inl %dx,%eax
  2881. movl %eax,12(%ebp)
  2882. end ['EAX','EBX'];
  2883. end;
  2884. Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
  2885. {
  2886. Reads 'Count' longints from port 'Port' to 'Buf'.
  2887. }
  2888. begin
  2889. asm
  2890. movl 16(%ebp),%ecx
  2891. movl 12(%ebp),%edi
  2892. movl 8(%ebp),%edx
  2893. cld
  2894. rep
  2895. insl
  2896. end ['ECX','ESI','EDX'];
  2897. end;
  2898. Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
  2899. {
  2900. Reads 'Count' words from port 'Port' to 'Buf'.
  2901. }
  2902. begin
  2903. asm
  2904. movl 16(%ebp),%ecx
  2905. movl 12(%ebp),%edi
  2906. movl 8(%ebp),%edx
  2907. cld
  2908. rep
  2909. insw
  2910. end ['ECX','ESI','EDX'];
  2911. end;
  2912. Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
  2913. {
  2914. Reads 'Count' bytes from port 'Port' to 'Buf'.
  2915. }
  2916. begin
  2917. asm
  2918. movl 16(%ebp),%ecx
  2919. movl 12(%ebp),%edi
  2920. movl 8(%ebp),%edx
  2921. cld
  2922. rep
  2923. insb
  2924. end ['ECX','ESI','EDX'];
  2925. end;
  2926. Begin
  2927. InitEpochToLocal;
  2928. End.
  2929. {
  2930. $Log$
  2931. Revision 1.9 1998-06-03 11:55:33 michael
  2932. + Added IO port calls
  2933. Revision 1.8 1998/05/06 18:45:32 peter
  2934. * fixed the shell() bug (the correct code was also in Popen) moved the
  2935. argv generation to CreateShellArgv
  2936. + Execve with pchar instead of string
  2937. Revision 1.7 1998/05/06 12:35:26 michael
  2938. + Removed log from before restored version.
  2939. Revision 1.6 1998/04/15 11:23:53 michael
  2940. + Added some calls to make common API more efficient
  2941. Revision 1.5 1998/04/10 15:23:03 michael
  2942. + Pclose now returns exit status of process
  2943. Revision 1.4 1998/04/07 13:08:29 michael
  2944. + Added flock for file locking
  2945. Revision 1.3 1998/04/07 12:27:41 peter
  2946. * fixed fexpand('..')
  2947. Revision 1.2 1998/04/04 17:07:17 michael
  2948. + Fixed AssignStream, it completely refused to work
  2949. }