linux.pp 69 KB

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