linux.pp 75 KB

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