linux.pp 69 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030
  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. {**************************
  709. Port IO functions
  710. ***************************}
  711. {$ifndef BSD}
  712. Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
  713. {$IFDEF I386}
  714. Procedure WritePort (Port : Longint; Value : Byte);
  715. Procedure WritePort (Port : Longint; Value : Word);
  716. Procedure WritePort (Port : Longint; Value : Longint);
  717. Procedure WritePortB (Port : Longint; Value : Byte);
  718. Procedure WritePortW (Port : Longint; Value : Word);
  719. Procedure WritePortL (Port : Longint; Value : Longint);
  720. Procedure WritePortL (Port : Longint; Var Buf; Count: longint);
  721. Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
  722. Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
  723. Procedure ReadPort (Port : Longint; Var Value : Byte);
  724. Procedure ReadPort (Port : Longint; Var Value : Word);
  725. Procedure ReadPort (Port : Longint; Var Value : Longint);
  726. function ReadPortB (Port : Longint): Byte;
  727. function ReadPortW (Port : Longint): Word;
  728. function ReadPortL (Port : Longint): LongInt;
  729. Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
  730. Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
  731. Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
  732. {$endif}
  733. {$endif}
  734. {**************************
  735. Utility functions
  736. ***************************}
  737. Function Octal(l:longint):longint;
  738. Function FExpand(Const Path: PathStr):PathStr;
  739. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  740. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  741. Function Dirname(Const path:pathstr):pathstr;
  742. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  743. Function FNMatch(const Pattern,Name:string):Boolean;
  744. Function Glob(Const path:pathstr):pglob;
  745. Procedure Globfree(var p:pglob);
  746. Function StringToPPChar(Var S:STring):ppchar;
  747. Function GetFS(var T:Text):longint;
  748. Function GetFS(Var F:File):longint;
  749. {Filedescriptorsets}
  750. Procedure FD_Zero(var fds:fdSet);
  751. Procedure FD_Clr(fd:longint;var fds:fdSet);
  752. Procedure FD_Set(fd:longint;var fds:fdSet);
  753. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  754. {Stat.Mode Types}
  755. Function S_ISLNK(m:word):boolean;
  756. Function S_ISREG(m:word):boolean;
  757. Function S_ISDIR(m:word):boolean;
  758. Function S_ISCHR(m:word):boolean;
  759. Function S_ISBLK(m:word):boolean;
  760. Function S_ISFIFO(m:word):boolean;
  761. Function S_ISSOCK(m:word):boolean;
  762. {******************************************************************************
  763. Implementation
  764. ******************************************************************************}
  765. Implementation
  766. Uses Strings;
  767. { Get the definitions of textrec and filerec }
  768. {$i textrec.inc}
  769. {$i filerec.inc}
  770. { Raw System calls are in Syscalls.inc}
  771. {$i syscalls.inc}
  772. {$ifdef BSD}
  773. {$i bsdsysca.inc}
  774. {$else}
  775. {$i linsysca.inc}
  776. {$endif}
  777. {******************************************************************************
  778. Process related calls
  779. ******************************************************************************}
  780. function CreateShellArgV(const prog:string):ppchar;
  781. {
  782. Create an argv which executes a command in a shell using /bin/sh -c
  783. }
  784. var
  785. pp,p : ppchar;
  786. temp : string;
  787. begin
  788. getmem(pp,4*4);
  789. temp:='/bin/sh'#0'-c'#0+prog+#0;
  790. p:=pp;
  791. p^:=@temp[1];
  792. inc(p);
  793. p^:=@temp[9];
  794. inc(p);
  795. p^:=@temp[12];
  796. inc(p);
  797. p^:=Nil;
  798. CreateShellArgV:=pp;
  799. end;
  800. function CreateShellArgV(const prog:Ansistring):ppchar;
  801. {
  802. Create an argv which executes a command in a shell using /bin/sh -c
  803. using a AnsiString;
  804. }
  805. var
  806. pp,p : ppchar;
  807. temp : AnsiString;
  808. begin
  809. getmem(pp,4*4);
  810. temp:='/bin/sh'#0'-c'#0+prog+#0;
  811. p:=pp;
  812. GetMem(p^,Length(Temp));
  813. Move(@Temp[1],p^^,Length(Temp));
  814. inc(p);
  815. p^:=@pp[0][8];
  816. inc(p);
  817. p^:=@pp[0][11];
  818. inc(p);
  819. p^:=Nil;
  820. CreateShellArgV:=pp;
  821. end;
  822. Procedure Execv(const path:pathstr;args:ppchar);
  823. {
  824. Replaces the current program by the program specified in path,
  825. arguments in args are passed to Execve.
  826. the current environment is passed on.
  827. }
  828. begin
  829. Execve(path,args,envp); {On error linuxerror will get set there}
  830. end;
  831. Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
  832. {
  833. This does the same as Execve, only it searches the PATH environment
  834. for the place of the Executable, except when Path starts with a slash.
  835. if the PATH environment variable is unavailable, the path is set to '.'
  836. }
  837. var
  838. thepath : string;
  839. begin
  840. if path[1]<>'/' then
  841. begin
  842. Thepath:=strpas(getenv('PATH'));
  843. if thepath='' then
  844. thepath:='.';
  845. Path:=FSearch(path,thepath)
  846. end
  847. else
  848. Path:='';
  849. if Path='' then
  850. linuxerror:=Sys_enoent
  851. else
  852. Execve(Path,args,ep);{On error linuxerror will get set there}
  853. end;
  854. Procedure Execle(Todo:string;Ep:ppchar);
  855. {
  856. This procedure takes the string 'Todo', parses it for command and
  857. command options, and Executes the command with the given options.
  858. The string 'Todo' shoud be of the form 'command options', options
  859. separated by commas.
  860. the PATH environment is not searched for 'command'.
  861. The specified environment(in 'ep') is passed on to command
  862. }
  863. var
  864. p : ppchar;
  865. begin
  866. p:=StringToPPChar(ToDo);
  867. if (p=nil) or (p^=nil) then
  868. exit;
  869. ExecVE(p^,p,EP);
  870. end;
  871. Procedure Execl(const Todo:string);
  872. {
  873. This procedure takes the string 'Todo', parses it for command and
  874. command options, and Executes the command with the given options.
  875. The string 'Todo' shoud be of the form 'command options', options
  876. separated by commas.
  877. the PATH environment is not searched for 'command'.
  878. The current environment is passed on to command
  879. }
  880. begin
  881. ExecLE(ToDo,EnvP);
  882. end;
  883. Procedure Execlp(Todo:string;Ep:ppchar);
  884. {
  885. This procedure takes the string 'Todo', parses it for command and
  886. command options, and Executes the command with the given options.
  887. The string 'Todo' shoud be of the form 'command options', options
  888. separated by commas.
  889. the PATH environment is searched for 'command'.
  890. The specified environment (in 'ep') is passed on to command
  891. }
  892. var
  893. p : ppchar;
  894. begin
  895. p:=StringToPPchar(todo);
  896. if (p=nil) or (p^=nil) then
  897. exit;
  898. ExecVP(StrPas(p^),p,EP);
  899. end;
  900. Function Shell(const Command:String):Longint;
  901. {
  902. Executes the shell, and passes it the string Command. (Through /bin/sh -c)
  903. The current environment is passed to the shell.
  904. It waits for the shell to exit, and returns its exit status.
  905. If the Exec call failed exit status 127 is reported.
  906. }
  907. var
  908. p : ppchar;
  909. temp,pid : longint;
  910. begin
  911. pid:=fork;
  912. if pid=-1 then
  913. exit; {Linuxerror already set in Fork}
  914. if pid=0 then
  915. begin
  916. {This is the child.}
  917. p:=CreateShellArgv(command);
  918. Execve(p^,p,envp);
  919. exit(127);
  920. end;
  921. temp:=0;
  922. WaitPid(pid,@temp,0);{Linuxerror is set there}
  923. Shell:=temp;{ Return exit status }
  924. end;
  925. Function Shell(const Command:AnsiString):Longint;
  926. {
  927. AnsiString version of Shell
  928. }
  929. var
  930. p : ppchar;
  931. temp,pid : longint;
  932. begin
  933. pid:=fork;
  934. if pid=-1 then
  935. exit; {Linuxerror already set in Fork}
  936. if pid=0 then
  937. begin
  938. {This is the child.}
  939. p:=CreateShellArgv(command);
  940. Execve(p^,p,envp);
  941. exit(127);
  942. end;
  943. temp:=0;
  944. WaitPid(pid,@temp,0);{Linuxerror is set there}
  945. Shell:=temp;{ Return exit status }
  946. end;
  947. {******************************************************************************
  948. Date and Time related calls
  949. ******************************************************************************}
  950. Const
  951. {Date Translation}
  952. C1970=2440588;
  953. D0 = 1461;
  954. D1 = 146097;
  955. D2 =1721119;
  956. Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
  957. Var
  958. Century,XYear: LongInt;
  959. Begin
  960. If Month<=2 Then
  961. Begin
  962. Dec(Year);
  963. Inc(Month,12);
  964. End;
  965. Dec(Month,3);
  966. Century:=(longint(Year Div 100)*D1) shr 2;
  967. XYear:=(longint(Year Mod 100)*D0) shr 2;
  968. GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
  969. End;
  970. Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
  971. Var
  972. YYear,XYear,Temp,TempMonth : LongInt;
  973. Begin
  974. Temp:=((JulianDN-D2) shl 2)-1;
  975. JulianDN:=Temp Div D1;
  976. XYear:=(Temp Mod D1) or 3;
  977. YYear:=(XYear Div D0);
  978. Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
  979. Day:=((Temp Mod 153)+5) Div 5;
  980. TempMonth:=Temp Div 153;
  981. If TempMonth>=10 Then
  982. Begin
  983. inc(YYear);
  984. dec(TempMonth,12);
  985. End;
  986. inc(TempMonth,3);
  987. Month := TempMonth;
  988. Year:=YYear+(JulianDN*100);
  989. end;
  990. Function GetEpochTime: longint;
  991. {
  992. Get the number of seconds since 00:00, January 1 1970, GMT
  993. the time NOT corrected any way
  994. }
  995. begin
  996. GetEpochTime:=GetTimeOfDay;
  997. end;
  998. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  999. {
  1000. Transforms Epoch time into local time (hour, minute,seconds)
  1001. }
  1002. Var
  1003. DateNum: LongInt;
  1004. Begin
  1005. inc(Epoch,TZSeconds);
  1006. Datenum:=(Epoch Div 86400) + c1970;
  1007. JulianToGregorian(DateNum,Year,Month,day);
  1008. Epoch:=Epoch Mod 86400;
  1009. Hour:=Epoch Div 3600;
  1010. Epoch:=Epoch Mod 3600;
  1011. Minute:=Epoch Div 60;
  1012. Second:=Epoch Mod 60;
  1013. End;
  1014. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  1015. {
  1016. Transforms local time (year,month,day,hour,minutes,second) to Epoch time
  1017. (seconds since 00:00, january 1 1970, corrected for local time zone)
  1018. }
  1019. Begin
  1020. LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
  1021. (LongInt(Hour)*3600)+(Minute*60)+Second-TZSeconds;
  1022. End;
  1023. procedure GetTime(var hour,min,sec,msec,usec:word);
  1024. {
  1025. Gets the current time, adjusted to local time
  1026. }
  1027. var
  1028. year,day,month:Word;
  1029. t : timeval;
  1030. begin
  1031. gettimeofday(t);
  1032. EpochToLocal(t.sec,year,month,day,hour,min,sec);
  1033. msec:=t.usec div 1000;
  1034. usec:=t.usec mod 1000;
  1035. end;
  1036. procedure GetTime(var hour,min,sec,sec100:word);
  1037. {
  1038. Gets the current time, adjusted to local time
  1039. }
  1040. var
  1041. usec : word;
  1042. begin
  1043. gettime(hour,min,sec,sec100,usec);
  1044. sec100:=sec100 div 10;
  1045. end;
  1046. Procedure GetTime(Var Hour,Min,Sec:Word);
  1047. {
  1048. Gets the current time, adjusted to local time
  1049. }
  1050. var
  1051. msec,usec : Word;
  1052. Begin
  1053. gettime(hour,min,sec,msec,usec);
  1054. End;
  1055. Procedure GetDate(Var Year,Month,Day:Word);
  1056. {
  1057. Gets the current date, adjusted to local time
  1058. }
  1059. var
  1060. hour,minute,second : word;
  1061. Begin
  1062. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  1063. End;
  1064. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  1065. {
  1066. Gets the current date, adjusted to local time
  1067. }
  1068. Begin
  1069. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  1070. End;
  1071. { Include timezone handling routines which use /usr/share/timezone info }
  1072. {$i timezone.inc}
  1073. {******************************************************************************
  1074. FileSystem calls
  1075. ******************************************************************************}
  1076. Function fdOpen(pathname:string;flags:longint):longint;
  1077. begin
  1078. pathname:=pathname+#0;
  1079. fdOpen:=Sys_Open(@pathname[1],flags,438);
  1080. LinuxError:=Errno;
  1081. end;
  1082. Function fdOpen(pathname:string;flags,mode:longint):longint;
  1083. begin
  1084. pathname:=pathname+#0;
  1085. fdOpen:=Sys_Open(@pathname[1],flags,mode);
  1086. LinuxError:=Errno;
  1087. end;
  1088. Function fdOpen(pathname:pchar;flags:longint):longint;
  1089. begin
  1090. fdOpen:=Sys_Open(pathname,flags,0);
  1091. LinuxError:=Errno;
  1092. end;
  1093. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  1094. begin
  1095. fdOpen:=Sys_Open(pathname,flags,mode);
  1096. LinuxError:=Errno;
  1097. end;
  1098. Function fdClose(fd:longint):boolean;
  1099. begin
  1100. fdClose:=(Sys_Close(fd)=0);
  1101. LinuxError:=Errno;
  1102. end;
  1103. Function fdRead(fd:longint;var buf;size:longint):longint;
  1104. begin
  1105. fdRead:=Sys_Read(fd,pchar(@buf),size);
  1106. LinuxError:=Errno;
  1107. end;
  1108. Function fdWrite(fd:longint;var buf;size:longint):longint;
  1109. begin
  1110. fdWrite:=Sys_Write(fd,pchar(@buf),size);
  1111. LinuxError:=Errno;
  1112. end;
  1113. Function fdSeek (fd,pos,seektype :longint): longint;
  1114. {
  1115. Do a Seek on a file descriptor fd to position pos, starting from seektype
  1116. }
  1117. begin
  1118. fdseek:=Sys_LSeek (fd,pos,seektype);
  1119. LinuxError:=Errno;
  1120. end;
  1121. {$ifdef BSD}
  1122. Function Fcntl(Fd:longint;Cmd:longint):longint;
  1123. {
  1124. Read or manipulate a file.(See also fcntl (2) )
  1125. Possible values for Cmd are :
  1126. F_GetFd,F_GetFl,F_GetOwn
  1127. Errors are reported in Linuxerror;
  1128. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  1129. }
  1130. begin
  1131. if (cmd in [F_GetFd,F_GetFl,F_GetOwn]) then
  1132. begin
  1133. Linuxerror:=sys_fcntl(fd,cmd,0);
  1134. if linuxerror=-1 then
  1135. begin
  1136. linuxerror:=errno;
  1137. fcntl:=0;
  1138. end
  1139. else
  1140. begin
  1141. fcntl:=linuxerror;
  1142. linuxerror:=0;
  1143. end;
  1144. end
  1145. else
  1146. begin
  1147. linuxerror:=Sys_einval;
  1148. Fcntl:=0;
  1149. end;
  1150. end;
  1151. Procedure Fcntl(Fd:longint;Cmd:longint;Arg:Longint);
  1152. {
  1153. Read or manipulate a file. (See also fcntl (2) )
  1154. Possible values for Cmd are :
  1155. F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
  1156. Errors are reported in Linuxerror;
  1157. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  1158. F_DupFD is not allowed, due to the structure of Files in Pascal.
  1159. }
  1160. begin
  1161. if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn]) then
  1162. begin
  1163. sys_fcntl(fd,cmd,arg);
  1164. LinuxError:=ErrNo;
  1165. end
  1166. else
  1167. linuxerror:=Sys_einval;
  1168. end;
  1169. {$endif}
  1170. {$ifdef BSD}
  1171. Function Fcntl(var Fd:Text;Cmd:longint):longint;
  1172. {$else}
  1173. Function Fcntl(var Fd:Text;Cmd:integer):integer;
  1174. {$endif}
  1175. begin
  1176. Fcntl := Fcntl(textrec(Fd).handle, Cmd);
  1177. end;
  1178. {$ifdef BSD}
  1179. Procedure Fcntl(var Fd:Text;Cmd,Arg:Longint);
  1180. {$else}
  1181. Procedure Fcntl(var Fd:Text;Cmd:Integer;Arg:Longint);
  1182. {$endif}
  1183. begin
  1184. Fcntl(textrec(Fd).handle, Cmd, Arg);
  1185. end;
  1186. Function Flock (var T : text;mode : longint) : boolean;
  1187. begin
  1188. Flock:=Flock(TextRec(T).Handle,mode);
  1189. end;
  1190. Function Flock (var F : File;mode : longint) : boolean;
  1191. begin
  1192. Flock:=Flock(FileRec(F).Handle,mode);
  1193. end;
  1194. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  1195. {
  1196. Get all information on a file, and return it in Info.
  1197. }
  1198. begin
  1199. path:=path+#0;
  1200. FStat:=(Sys_stat(@(path[1]),Info)=0);
  1201. LinuxError:=errno;
  1202. end;
  1203. Function FStat(var F:Text;Var Info:stat):Boolean;
  1204. {
  1205. Get all information on a text file, and return it in info.
  1206. }
  1207. begin
  1208. FStat:=Fstat(TextRec(F).Handle,INfo);
  1209. end;
  1210. Function FStat(var F:File;Var Info:stat):Boolean;
  1211. {
  1212. Get all information on a untyped file, and return it in info.
  1213. }
  1214. begin
  1215. FStat:=Fstat(FileRec(F).Handle,Info);
  1216. end;
  1217. Function SymLink(OldPath,newPath:pathstr):boolean;
  1218. {
  1219. Proceduces a soft link from new to old.
  1220. }
  1221. begin
  1222. oldpath:=oldpath+#0;
  1223. newpath:=newpath+#0;
  1224. Symlink:=Sys_symlink(pchar(@(oldpath[1])),pchar(@(newpath[1])))=0;
  1225. linuxerror:=errno;
  1226. end;
  1227. Function ReadLink(name,linkname:pchar;maxlen:longint):longint;
  1228. {
  1229. Read a link (where it points to)
  1230. }
  1231. begin
  1232. Readlink:=Sys_readlink(Name,LinkName,maxlen);
  1233. linuxerror:=errno;
  1234. end;
  1235. Function ReadLink(Name:pathstr):pathstr;
  1236. {
  1237. Read a link (where it points to)
  1238. }
  1239. var
  1240. LinkName : pathstr;
  1241. i : longint;
  1242. begin
  1243. Name:=Name+#0;
  1244. i:=ReadLink(@Name[1],@LinkName[1],high(linkname));
  1245. if i>0 then
  1246. begin
  1247. linkname[0]:=chr(i);
  1248. ReadLink:=LinkName;
  1249. end
  1250. else
  1251. ReadLink:='';
  1252. end;
  1253. Function UnLink(Path:pathstr):boolean;
  1254. {
  1255. Removes the file in 'Path' (that is, it decreases the link count with one.
  1256. if the link count is zero, the file is removed from the disk.
  1257. }
  1258. begin
  1259. path:=path+#0;
  1260. Unlink:=Sys_unlink(pchar(@(path[1])))=0;
  1261. linuxerror:=errno;
  1262. end;
  1263. Function UnLink(Path:pchar):Boolean;
  1264. {
  1265. Removes the file in 'Path' (that is, it decreases the link count with one.
  1266. if the link count is zero, the file is removed from the disk.
  1267. }
  1268. begin
  1269. Unlink:=(Sys_unlink(path)=0);
  1270. linuxerror:=errno;
  1271. end;
  1272. Function FRename (OldName,NewName : Pchar) : Boolean;
  1273. begin
  1274. FRename:=Sys_rename(OldName,NewName)=0;
  1275. LinuxError:=Errno;
  1276. end;
  1277. Function FRename (OldName,NewName : String) : Boolean;
  1278. begin
  1279. OldName:=OldName+#0;
  1280. NewName:=NewName+#0;
  1281. FRename:=FRename (@OldName[1],@NewName[1]);
  1282. end;
  1283. Function Dup(var oldfile,newfile:text):Boolean;
  1284. {
  1285. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  1286. oldfile.
  1287. After which the two textfiles are, in effect, the same, except
  1288. that they don't share the same buffer, and don't share the same
  1289. close_on_exit flag.
  1290. }
  1291. begin
  1292. flush(oldfile);{ We cannot share buffers, so we flush them. }
  1293. textrec(newfile):=textrec(oldfile);
  1294. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  1295. Dup:=Dup(textrec(oldfile).handle,textrec(newfile).handle);
  1296. end;
  1297. Function Dup(var oldfile,newfile:file):Boolean;
  1298. {
  1299. Copies the filedescriptor oldfile to newfile
  1300. }
  1301. begin
  1302. filerec(newfile):=filerec(oldfile);
  1303. Dup:=Dup(filerec(oldfile).handle,filerec(newfile).handle);
  1304. end;
  1305. Function Dup2(var oldfile,newfile:text):Boolean;
  1306. {
  1307. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  1308. oldfile. It closes newfile if it was still open.
  1309. After which the two textfiles are, in effect, the same, except
  1310. that they don't share the same buffer, and don't share the same
  1311. close_on_exit flag.
  1312. }
  1313. var
  1314. tmphandle : word;
  1315. begin
  1316. case TextRec(oldfile).mode of
  1317. fmOutput, fmInOut, fmAppend :
  1318. flush(oldfile);{ We cannot share buffers, so we flush them. }
  1319. end;
  1320. case TextRec(newfile).mode of
  1321. fmOutput, fmInOut, fmAppend :
  1322. flush(newfile);
  1323. end;
  1324. tmphandle:=textrec(newfile).handle;
  1325. textrec(newfile):=textrec(oldfile);
  1326. textrec(newfile).handle:=tmphandle;
  1327. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  1328. Dup2:=Dup2(textrec(oldfile).handle,textrec(newfile).handle);
  1329. end;
  1330. Function Dup2(var oldfile,newfile:file):Boolean;
  1331. {
  1332. Copies the filedescriptor oldfile to newfile
  1333. }
  1334. begin
  1335. filerec(newfile):=filerec(oldfile);
  1336. Dup2:=Dup2(filerec(oldfile).handle,filerec(newfile).handle);
  1337. end;
  1338. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  1339. {
  1340. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  1341. have changed.
  1342. This function allows specification of a timeout as a longint.
  1343. }
  1344. var
  1345. p : PTimeVal;
  1346. tv : TimeVal;
  1347. begin
  1348. if TimeOut=-1 then
  1349. p:=nil
  1350. else
  1351. begin
  1352. tv.Sec:=Timeout div 1000;
  1353. tv.Usec:=(Timeout mod 1000)*1000;
  1354. p:=@tv;
  1355. end;
  1356. Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
  1357. end;
  1358. Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
  1359. Var
  1360. F:FDSet;
  1361. begin
  1362. if textrec(t).mode=fmclosed then
  1363. begin
  1364. LinuxError:=Sys_EBADF;
  1365. exit(-1);
  1366. end;
  1367. FD_Zero(f);
  1368. FD_Set(textrec(T).handle,f);
  1369. if textrec(T).mode=fminput then
  1370. SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
  1371. else
  1372. SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
  1373. end;
  1374. {******************************************************************************
  1375. Directory
  1376. ******************************************************************************}
  1377. Function OpenDir(F:String):PDir;
  1378. begin
  1379. F:=F+#0;
  1380. OpenDir:=OpenDir(@F[1]);
  1381. end;
  1382. procedure SeekDir(p:pdir;off:longint);
  1383. begin
  1384. if p=nil then
  1385. begin
  1386. errno:=Sys_EBADF;
  1387. exit;
  1388. end;
  1389. {$ifndef bsd}
  1390. p^.nextoff:=Sys_lseek(p^.fd,off,seek_set);
  1391. {$endif}
  1392. p^.size:=0;
  1393. p^.loc:=0;
  1394. end;
  1395. function TellDir(p:pdir):longint;
  1396. begin
  1397. if p=nil then
  1398. begin
  1399. errno:=Sys_EBADF;
  1400. telldir:=-1;
  1401. exit;
  1402. end;
  1403. telldir:=Sys_lseek(p^.fd,0,seek_cur)
  1404. { We could try to use the nextoff field here, but on my 1.2.13
  1405. kernel, this gives nothing... This may have to do with
  1406. the readdir implementation of libc... I also didn't find any trace of
  1407. the field in the kernel code itself, So I suspect it is an artifact of libc.
  1408. Michael. }
  1409. end;
  1410. Function ReadDir(P:pdir):pdirent;
  1411. begin
  1412. ReadDir:=Sys_ReadDir(p);
  1413. LinuxError:=Errno;
  1414. end;
  1415. {******************************************************************************
  1416. Pipes/Fifo
  1417. ******************************************************************************}
  1418. Procedure OpenPipe(var F:Text);
  1419. begin
  1420. case textrec(f).mode of
  1421. fmoutput :
  1422. if textrec(f).userdata[1]<>P_OUT then
  1423. textrec(f).mode:=fmclosed;
  1424. fminput :
  1425. if textrec(f).userdata[1]<>P_IN then
  1426. textrec(f).mode:=fmclosed;
  1427. else
  1428. textrec(f).mode:=fmclosed;
  1429. end;
  1430. end;
  1431. Procedure IOPipe(var F:text);
  1432. begin
  1433. case textrec(f).mode of
  1434. fmoutput :
  1435. begin
  1436. { first check if we need something to write, else we may
  1437. get a SigPipe when Close() is called (PFV) }
  1438. if textrec(f).bufpos>0 then
  1439. Sys_write(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
  1440. end;
  1441. fminput :
  1442. textrec(f).bufend:=Sys_read(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
  1443. end;
  1444. textrec(f).bufpos:=0;
  1445. end;
  1446. Procedure FlushPipe(var F:Text);
  1447. begin
  1448. if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
  1449. IOPipe(f);
  1450. textrec(f).bufpos:=0;
  1451. end;
  1452. Procedure ClosePipe(var F:text);
  1453. begin
  1454. textrec(f).mode:=fmclosed;
  1455. Sys_close(textrec(f).handle);
  1456. end;
  1457. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  1458. {
  1459. Sets up a pair of file variables, which act as a pipe. The first one can
  1460. be read from, the second one can be written to.
  1461. If the operation was unsuccesful, linuxerror is set.
  1462. }
  1463. var
  1464. f_in,f_out : longint;
  1465. begin
  1466. if not AssignPipe(f_in,f_out) then
  1467. begin
  1468. AssignPipe:=false;
  1469. exit;
  1470. end;
  1471. { Set up input }
  1472. Assign(Pipe_in,'');
  1473. Textrec(Pipe_in).Handle:=f_in;
  1474. Textrec(Pipe_in).Mode:=fmInput;
  1475. Textrec(Pipe_in).userdata[1]:=P_IN;
  1476. TextRec(Pipe_in).OpenFunc:=@OpenPipe;
  1477. TextRec(Pipe_in).InOutFunc:=@IOPipe;
  1478. TextRec(Pipe_in).FlushFunc:=@FlushPipe;
  1479. TextRec(Pipe_in).CloseFunc:=@ClosePipe;
  1480. { Set up output }
  1481. Assign(Pipe_out,'');
  1482. Textrec(Pipe_out).Handle:=f_out;
  1483. Textrec(Pipe_out).Mode:=fmOutput;
  1484. Textrec(Pipe_out).userdata[1]:=P_OUT;
  1485. TextRec(Pipe_out).OpenFunc:=@OpenPipe;
  1486. TextRec(Pipe_out).InOutFunc:=@IOPipe;
  1487. TextRec(Pipe_out).FlushFunc:=@FlushPipe;
  1488. TextRec(Pipe_out).CloseFunc:=@ClosePipe;
  1489. AssignPipe:=true;
  1490. end;
  1491. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  1492. {
  1493. Sets up a pair of file variables, which act as a pipe. The first one can
  1494. be read from, the second one can be written to.
  1495. If the operation was unsuccesful, linuxerror is set.
  1496. }
  1497. var
  1498. f_in,f_out : longint;
  1499. begin
  1500. if not AssignPipe(f_in,f_out) then
  1501. begin
  1502. AssignPipe:=false;
  1503. exit;
  1504. end;
  1505. { Set up input }
  1506. Assign(Pipe_in,'');
  1507. Filerec(Pipe_in).Handle:=f_in;
  1508. Filerec(Pipe_in).Mode:=fmInput;
  1509. Filerec(Pipe_in).recsize:=1;
  1510. Filerec(Pipe_in).userdata[1]:=P_IN;
  1511. { Set up output }
  1512. Assign(Pipe_out,'');
  1513. Filerec(Pipe_out).Handle:=f_out;
  1514. Filerec(Pipe_out).Mode:=fmoutput;
  1515. Filerec(Pipe_out).recsize:=1;
  1516. Filerec(Pipe_out).userdata[1]:=P_OUT;
  1517. AssignPipe:=true;
  1518. end;
  1519. Procedure PCloseText(Var F:text);
  1520. {
  1521. May not use @PClose due overloading
  1522. }
  1523. begin
  1524. PClose(f);
  1525. end;
  1526. Procedure POpen(var F:text;const Prog:String;rw:char);
  1527. {
  1528. Starts the program in 'Prog' and makes it's input or out put the
  1529. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  1530. F, will be read from stdin by the program in 'Prog'. The inverse is true
  1531. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  1532. read from 'f'.
  1533. }
  1534. var
  1535. pipi,
  1536. pipo : text;
  1537. pid : longint;
  1538. pl : ^longint;
  1539. pp : ppchar;
  1540. begin
  1541. LinuxError:=0;
  1542. rw:=upcase(rw);
  1543. if not (rw in ['R','W']) then
  1544. begin
  1545. LinuxError:=Sys_enoent;
  1546. exit;
  1547. end;
  1548. AssignPipe(pipi,pipo);
  1549. if Linuxerror<>0 then
  1550. exit;
  1551. pid:=fork;
  1552. if linuxerror<>0 then
  1553. begin
  1554. close(pipi);
  1555. close(pipo);
  1556. exit;
  1557. end;
  1558. if pid=0 then
  1559. begin
  1560. { We're in the child }
  1561. if rw='W' then
  1562. begin
  1563. close(pipo);
  1564. dup2(pipi,input);
  1565. close(pipi);
  1566. if linuxerror<>0 then
  1567. halt(127);
  1568. end
  1569. else
  1570. begin
  1571. close(pipi);
  1572. dup2(pipo,output);
  1573. close(pipo);
  1574. if linuxerror<>0 then
  1575. halt(127);
  1576. end;
  1577. pp:=createshellargv(prog);
  1578. Execve(pp^,pp,envp);
  1579. halt(127);
  1580. end
  1581. else
  1582. begin
  1583. { We're in the parent }
  1584. if rw='W' then
  1585. begin
  1586. close(pipi);
  1587. f:=pipo;
  1588. textrec(f).bufptr:=@textrec(f).buffer;
  1589. end
  1590. else
  1591. begin
  1592. close(pipo);
  1593. f:=pipi;
  1594. textrec(f).bufptr:=@textrec(f).buffer;
  1595. end;
  1596. {Save the process ID - needed when closing }
  1597. pl:=@(textrec(f).userdata[2]);
  1598. pl^:=pid;
  1599. textrec(f).closefunc:=@PCloseText;
  1600. end;
  1601. end;
  1602. Procedure POpen(var F:file;const Prog:String;rw:char);
  1603. {
  1604. Starts the program in 'Prog' and makes it's input or out put the
  1605. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  1606. F, will be read from stdin by the program in 'Prog'. The inverse is true
  1607. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  1608. read from 'f'.
  1609. }
  1610. var
  1611. pipi,
  1612. pipo : file;
  1613. pid : longint;
  1614. pl : ^longint;
  1615. p,pp : ppchar;
  1616. temp : string[255];
  1617. begin
  1618. LinuxError:=0;
  1619. rw:=upcase(rw);
  1620. if not (rw in ['R','W']) then
  1621. begin
  1622. LinuxError:=Sys_enoent;
  1623. exit;
  1624. end;
  1625. AssignPipe(pipi,pipo);
  1626. if Linuxerror<>0 then
  1627. exit;
  1628. pid:=fork;
  1629. if linuxerror<>0 then
  1630. begin
  1631. close(pipi);
  1632. close(pipo);
  1633. exit;
  1634. end;
  1635. if pid=0 then
  1636. begin
  1637. { We're in the child }
  1638. if rw='W' then
  1639. begin
  1640. close(pipo);
  1641. dup2(filerec(pipi).handle,stdinputhandle);
  1642. close(pipi);
  1643. if linuxerror<>0 then
  1644. halt(127);
  1645. end
  1646. else
  1647. begin
  1648. close(pipi);
  1649. dup2(filerec(pipo).handle,stdoutputhandle);
  1650. close(pipo);
  1651. if linuxerror<>0 then
  1652. halt(127);
  1653. end;
  1654. getmem(pp,sizeof(pchar)*4);
  1655. temp:='/bin/sh'#0'-c'#0+prog+#0;
  1656. p:=pp;
  1657. p^:=@temp[1];
  1658. inc(p);
  1659. p^:=@temp[9];
  1660. inc(p);
  1661. p^:=@temp[12];
  1662. inc(p);
  1663. p^:=Nil;
  1664. Execve('/bin/sh',pp,envp);
  1665. halt(127);
  1666. end
  1667. else
  1668. begin
  1669. { We're in the parent }
  1670. if rw='W' then
  1671. begin
  1672. close(pipi);
  1673. f:=pipo;
  1674. end
  1675. else
  1676. begin
  1677. close(pipo);
  1678. f:=pipi;
  1679. end;
  1680. {Save the process ID - needed when closing }
  1681. pl:=@(filerec(f).userdata[2]);
  1682. pl^:=pid;
  1683. end;
  1684. end;
  1685. Function AssignStream(Var StreamIn,Streamout:text;Const Prog:String) : longint;
  1686. {
  1687. Starts the program in 'Prog' and makes its input and output the
  1688. other end of two pipes, which are the stdin and stdout of a program
  1689. specified in 'Prog'.
  1690. streamout can be used to write to the program, streamin can be used to read
  1691. the output of the program. See the following diagram :
  1692. Parent Child
  1693. STreamout --> Input
  1694. Streamin <-- Output
  1695. Return value is the process ID of the process being spawned, or -1 in case of failure.
  1696. }
  1697. var
  1698. pipi,
  1699. pipo : text;
  1700. pid : longint;
  1701. pl : ^Longint;
  1702. begin
  1703. LinuxError:=0;
  1704. AssignStream:=-1;
  1705. AssignPipe(streamin,pipo);
  1706. if Linuxerror<>0 then
  1707. exit;
  1708. AssignPipe(pipi,streamout);
  1709. if Linuxerror<>0 then
  1710. exit;
  1711. pid:=fork;
  1712. if linuxerror<>0 then
  1713. begin
  1714. close(pipi);
  1715. close(pipo);
  1716. close (streamin);
  1717. close (streamout);
  1718. exit;
  1719. end;
  1720. if pid=0 then
  1721. begin
  1722. { We're in the child }
  1723. { Close what we don't need }
  1724. close(streamout);
  1725. close(streamin);
  1726. dup2(pipi,input);
  1727. if linuxerror<>0 then
  1728. halt(127);
  1729. close(pipi);
  1730. dup2(pipo,output);
  1731. if linuxerror<>0 then
  1732. halt (127);
  1733. close(pipo);
  1734. Execl(Prog);
  1735. halt(127);
  1736. end
  1737. else
  1738. begin
  1739. { we're in the parent}
  1740. close(pipo);
  1741. close(pipi);
  1742. {Save the process ID - needed when closing }
  1743. pl:=@(textrec(StreamIn).userdata[2]);
  1744. pl^:=pid;
  1745. textrec(StreamIn).closefunc:=@PCloseText;
  1746. {Save the process ID - needed when closing }
  1747. pl:=@(textrec(StreamOut).userdata[2]);
  1748. pl^:=pid;
  1749. textrec(StreamOut).closefunc:=@PCloseText;
  1750. AssignStream:=Pid;
  1751. end;
  1752. end;
  1753. function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
  1754. {
  1755. Starts the program in 'prog' and makes its input, output and error output the
  1756. other end of three pipes, which are the stdin, stdout and stderr of a program
  1757. specified in 'prog'.
  1758. StreamOut can be used to write to the program, StreamIn can be used to read
  1759. the output of the program, StreamErr reads the error output of the program.
  1760. See the following diagram :
  1761. Parent Child
  1762. StreamOut --> StdIn (input)
  1763. StreamIn <-- StdOut (output)
  1764. StreamErr <-- StdErr (error output)
  1765. }
  1766. var
  1767. PipeIn, PipeOut, PipeErr: text;
  1768. pid: LongInt;
  1769. pl: ^LongInt;
  1770. begin
  1771. LinuxError := 0;
  1772. AssignStream := -1;
  1773. // Assign pipes
  1774. AssignPipe(StreamIn, PipeOut);
  1775. if LinuxError <> 0 then exit;
  1776. AssignPipe(StreamErr, PipeErr);
  1777. if LinuxError <> 0 then begin
  1778. Close(StreamIn);
  1779. Close(PipeOut);
  1780. exit;
  1781. end;
  1782. AssignPipe(PipeIn, StreamOut);
  1783. if LinuxError <> 0 then begin
  1784. Close(StreamIn);
  1785. Close(PipeOut);
  1786. Close(StreamErr);
  1787. Close(PipeErr);
  1788. exit;
  1789. end;
  1790. // Fork
  1791. pid := Fork;
  1792. if LinuxError <> 0 then begin
  1793. Close(StreamIn);
  1794. Close(PipeOut);
  1795. Close(StreamErr);
  1796. Close(PipeErr);
  1797. Close(PipeIn);
  1798. Close(StreamOut);
  1799. exit;
  1800. end;
  1801. if pid = 0 then begin
  1802. // *** We are in the child ***
  1803. // Close what we don not need
  1804. Close(StreamOut);
  1805. Close(StreamIn);
  1806. Close(StreamErr);
  1807. // Connect pipes
  1808. dup2(PipeIn, Input);
  1809. if LinuxError <> 0 then Halt(127);
  1810. Close(PipeIn);
  1811. dup2(PipeOut, Output);
  1812. if LinuxError <> 0 then Halt(127);
  1813. Close(PipeOut);
  1814. dup2(PipeErr, StdErr);
  1815. if LinuxError <> 0 then Halt(127);
  1816. Close(PipeErr);
  1817. // Execute program
  1818. Execl(Prog);
  1819. Halt(127);
  1820. end else begin
  1821. // *** We are in the parent ***
  1822. Close(PipeErr);
  1823. Close(PipeOut);
  1824. Close(PipeIn);
  1825. // Save the process ID - needed when closing
  1826. pl := @(TextRec(StreamIn).userdata[2]);
  1827. pl^ := pid;
  1828. TextRec(StreamIn).closefunc := @PCloseText;
  1829. // Save the process ID - needed when closing
  1830. pl := @(TextRec(StreamOut).userdata[2]);
  1831. pl^ := pid;
  1832. TextRec(StreamOut).closefunc := @PCloseText;
  1833. // Save the process ID - needed when closing
  1834. pl := @(TextRec(StreamErr).userdata[2]);
  1835. pl^ := pid;
  1836. TextRec(StreamErr).closefunc := @PCloseText;
  1837. AssignStream := pid;
  1838. end;
  1839. end;
  1840. {******************************************************************************
  1841. General information calls
  1842. ******************************************************************************}
  1843. Function GetEnv(P:string):Pchar;
  1844. {
  1845. Searches the environment for a string with name p and
  1846. returns a pchar to it's value.
  1847. A pchar is used to accomodate for strings of length > 255
  1848. }
  1849. var
  1850. ep : ppchar;
  1851. found : boolean;
  1852. Begin
  1853. p:=p+'='; {Else HOST will also find HOSTNAME, etc}
  1854. ep:=envp;
  1855. found:=false;
  1856. if ep<>nil then
  1857. begin
  1858. while (not found) and (ep^<>nil) do
  1859. begin
  1860. if strlcomp(@p[1],(ep^),length(p))=0 then
  1861. found:=true
  1862. else
  1863. inc(ep);
  1864. end;
  1865. end;
  1866. if found then
  1867. getenv:=ep^+length(p)
  1868. else
  1869. getenv:=nil;
  1870. end;
  1871. {$ifndef bsd}
  1872. Function GetDomainName:String;
  1873. {
  1874. Get machines domain name. Returns empty string if not set.
  1875. }
  1876. Var
  1877. Sysn : utsname;
  1878. begin
  1879. Uname(Sysn);
  1880. linuxerror:=errno;
  1881. If linuxerror<>0 then
  1882. getdomainname:=''
  1883. else
  1884. getdomainname:=strpas(@Sysn.domainname[0]);
  1885. end;
  1886. Function GetHostName:String;
  1887. {
  1888. Get machines name. Returns empty string if not set.
  1889. }
  1890. Var
  1891. Sysn : utsname;
  1892. begin
  1893. uname(Sysn);
  1894. linuxerror:=errno;
  1895. If linuxerror<>0 then
  1896. gethostname:=''
  1897. else
  1898. gethostname:=strpas(@Sysn.nodename[0]);
  1899. end;
  1900. {$endif}
  1901. {******************************************************************************
  1902. Signal handling calls
  1903. ******************************************************************************}
  1904. procedure SigRaise(sig:integer);
  1905. begin
  1906. Kill(GetPid,Sig);
  1907. end;
  1908. {******************************************************************************
  1909. IOCtl and Termios calls
  1910. ******************************************************************************}
  1911. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  1912. begin
  1913. TCGetAttr:=IOCtl(fd,TCGETS,@tios);
  1914. end;
  1915. Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
  1916. var
  1917. nr:longint;
  1918. begin
  1919. case OptAct of
  1920. TCSANOW : nr:=TCSETS;
  1921. TCSADRAIN : nr:=TCSETSW;
  1922. TCSAFLUSH : nr:=TCSETSF;
  1923. else
  1924. begin
  1925. ErrNo:=Sys_EINVAL;
  1926. TCSetAttr:=false;
  1927. exit;
  1928. end;
  1929. end;
  1930. TCSetAttr:=IOCtl(fd,nr,@Tios);
  1931. end;
  1932. Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
  1933. begin
  1934. tios.c_cflag:=(tios.c_cflag and (not CBAUD)) or speed;
  1935. end;
  1936. Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
  1937. begin
  1938. CFSetISpeed(tios,speed);
  1939. end;
  1940. Procedure CFMakeRaw(var tios:TermIOS);
  1941. begin
  1942. with tios do
  1943. begin
  1944. c_iflag:=c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
  1945. INLCR or IGNCR or ICRNL or IXON));
  1946. c_oflag:=c_oflag and (not OPOST);
  1947. c_lflag:=c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
  1948. c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or CS8;
  1949. end;
  1950. end;
  1951. Function TCSendBreak(fd,duration:longint):boolean;
  1952. begin
  1953. TCSendBreak:=IOCtl(fd,TCSBRK,pointer(duration));
  1954. end;
  1955. Function TCSetPGrp(fd,id:longint):boolean;
  1956. begin
  1957. TCSetPGrp:=IOCtl(fd,TIOCSPGRP,pointer(id));
  1958. end;
  1959. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  1960. begin
  1961. TCGetPGrp:=IOCtl(fd,TIOCGPGRP,@id);
  1962. end;
  1963. Function TCDrain(fd:longint):boolean;
  1964. begin
  1965. TCDrain:=IOCtl(fd,TCSBRK,pointer(1));
  1966. end;
  1967. Function TCFlow(fd,act:longint):boolean;
  1968. begin
  1969. TCFlow:=IOCtl(fd,TCXONC,pointer(act));
  1970. end;
  1971. Function TCFlush(fd,qsel:longint):boolean;
  1972. begin
  1973. TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
  1974. end;
  1975. Function IsATTY(Handle:Longint):Boolean;
  1976. {
  1977. Check if the filehandle described by 'handle' is a TTY (Terminal)
  1978. }
  1979. var
  1980. t : Termios;
  1981. begin
  1982. IsAtty:=TCGetAttr(Handle,t);
  1983. end;
  1984. Function IsATTY(f: text):Boolean;
  1985. {
  1986. Idem as previous, only now for text variables.
  1987. }
  1988. begin
  1989. IsATTY:=IsaTTY(textrec(f).handle);
  1990. end;
  1991. function TTYName(Handle:Longint):string;
  1992. {
  1993. Return the name of the current tty described by handle f.
  1994. returns empty string in case of an error.
  1995. }
  1996. Const
  1997. dev='/dev';
  1998. var
  1999. name : string;
  2000. st : stat;
  2001. mydev,
  2002. myino : longint;
  2003. dirstream : pdir;
  2004. d : pdirent;
  2005. begin
  2006. TTYName:='';
  2007. fstat(handle,st);
  2008. if (errno<>0) and isatty (handle) then
  2009. exit;
  2010. mydev:=st.dev;
  2011. myino:=st.ino;
  2012. dirstream:=opendir(dev);
  2013. if (linuxerror<>0) then
  2014. exit;
  2015. d:=Readdir(dirstream);
  2016. while (d<>nil) do
  2017. begin
  2018. if (d^.ino=myino) then
  2019. begin
  2020. name:=dev+'/'+strpas(@(d^.name));
  2021. fstat(name,st);
  2022. if (linuxerror=0) and (st.dev=mydev) then
  2023. begin
  2024. closedir(dirstream);
  2025. ttyname:=name;
  2026. exit;
  2027. end;
  2028. end;
  2029. d:=Readdir(dirstream);
  2030. end;
  2031. closedir(dirstream);
  2032. end;
  2033. function TTYName(var F:Text):string;
  2034. {
  2035. Idem as previous, only now for text variables;
  2036. }
  2037. begin
  2038. TTYName:=TTYName(textrec(f).handle);
  2039. end;
  2040. {******************************************************************************
  2041. Utility calls
  2042. ******************************************************************************}
  2043. Function Octal(l:longint):longint;
  2044. {
  2045. Convert an octal specified number to decimal;
  2046. }
  2047. var
  2048. octnr,
  2049. oct : longint;
  2050. begin
  2051. octnr:=0;
  2052. oct:=0;
  2053. while (l>0) do
  2054. begin
  2055. oct:=oct or ((l mod 10) shl octnr);
  2056. l:=l div 10;
  2057. inc(octnr,3);
  2058. end;
  2059. Octal:=oct;
  2060. end;
  2061. Function StringToPPChar(Var S:STring):ppchar;
  2062. {
  2063. Create a PPChar to structure of pchars which are the arguments specified
  2064. in the string S. Especially usefull for creating an ArgV for Exec-calls
  2065. }
  2066. var
  2067. nr : longint;
  2068. Buf : ^char;
  2069. p : ppchar;
  2070. begin
  2071. s:=s+#0;
  2072. buf:=@s[1];
  2073. nr:=0;
  2074. while(buf^<>#0) do
  2075. begin
  2076. while (buf^ in [' ',#8,#10]) do
  2077. inc(buf);
  2078. inc(nr);
  2079. while not (buf^ in [' ',#0,#8,#10]) do
  2080. inc(buf);
  2081. end;
  2082. getmem(p,nr*4);
  2083. StringToPPChar:=p;
  2084. if p=nil then
  2085. begin
  2086. LinuxError:=sys_enomem;
  2087. exit;
  2088. end;
  2089. buf:=@s[1];
  2090. while (buf^<>#0) do
  2091. begin
  2092. while (buf^ in [' ',#8,#10]) do
  2093. begin
  2094. buf^:=#0;
  2095. inc(buf);
  2096. end;
  2097. p^:=buf;
  2098. inc(p);
  2099. p^:=nil;
  2100. while not (buf^ in [' ',#0,#8,#10]) do
  2101. inc(buf);
  2102. end;
  2103. end;
  2104. Function FExpand(Const Path:PathStr):PathStr;
  2105. var
  2106. temp : pathstr;
  2107. i,j : longint;
  2108. p : pchar;
  2109. Begin
  2110. {Remove eventual drive - doesn't exist in Linux}
  2111. if path[2]=':' then
  2112. i:=3
  2113. else
  2114. i:=1;
  2115. temp:='';
  2116. {Replace ~/ with $HOME}
  2117. if (path[i]='~') and ((i+1>length(path)) or (path[i+1]='/')) then
  2118. begin
  2119. p:=getenv('HOME');
  2120. if not (p=nil) then
  2121. Insert(StrPas(p),temp,i);
  2122. i:=1;
  2123. temp:=temp+Copy(Path,2,255);
  2124. end;
  2125. {Do we have an absolute path ? No - prefix the current dir}
  2126. if temp='' then
  2127. begin
  2128. if path[i]<>'/' then
  2129. begin
  2130. {$I-}
  2131. getdir(0,temp);
  2132. {$I+}
  2133. if ioresult<>0 then;
  2134. end
  2135. else
  2136. inc(i);
  2137. temp:=temp+'/'+copy(path,i,length(path)-i+1)+'/';
  2138. end;
  2139. {First remove all references to '/./'}
  2140. while pos('/./',temp)<>0 do
  2141. delete(temp,pos('/./',temp),2);
  2142. {Now remove also all references to '/../' + of course previous dirs..}
  2143. repeat
  2144. i:=pos('/../',temp);
  2145. {Find the pos of the previous dir}
  2146. if i>1 then
  2147. begin
  2148. j:=i-1;
  2149. while (j>1) and (temp[j]<>'/') do
  2150. dec (j);{temp[1] is always '/'}
  2151. delete(temp,j,i-j+3);
  2152. end
  2153. else
  2154. if i=1 then {i=1, so we have temp='/../something', just delete '/../'}
  2155. delete(temp,1,3);
  2156. until i=0;
  2157. { Remove ending /.. }
  2158. i:=pos('/..',temp);
  2159. if (i<>0) and (i =length(temp)-2) then
  2160. begin
  2161. j:=i-1;
  2162. while (j>1) and (temp[j]<>'/') do
  2163. dec (j);
  2164. delete (temp,j,i-j+3);
  2165. end;
  2166. { if last character is / then remove it - dir is also a file :-) }
  2167. if (length(temp)>0) and (temp[length(temp)]='/') then
  2168. dec(byte(temp[0]));
  2169. fexpand:=temp;
  2170. End;
  2171. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  2172. {
  2173. Searches for a file 'path' in the list of direcories in 'dirlist'.
  2174. returns an empty string if not found. Wildcards are NOT allowed.
  2175. If dirlist is empty, it is set to '.'
  2176. }
  2177. Var
  2178. NewDir : PathStr;
  2179. p1 : Longint;
  2180. Info : Stat;
  2181. Begin
  2182. {Replace ':' with ';'}
  2183. for p1:=1to length(dirlist) do
  2184. if dirlist[p1]=':' then
  2185. dirlist[p1]:=';';
  2186. {Check for WildCards}
  2187. If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
  2188. FSearch:='' {No wildcards allowed in these things.}
  2189. Else
  2190. Begin
  2191. Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
  2192. Repeat
  2193. p1:=Pos(';',DirList);
  2194. If p1=0 Then
  2195. p1:=255;
  2196. NewDir:=Copy(DirList,1,P1 - 1);
  2197. if NewDir[Length(NewDir)]<>'/' then
  2198. NewDir:=NewDir+'/';
  2199. NewDir:=NewDir+Path;
  2200. Delete(DirList,1,p1);
  2201. if FStat(NewDir,Info) then
  2202. Begin
  2203. If Pos('./',NewDir)=1 Then
  2204. Delete(NewDir,1,2);
  2205. {DOS strips off an initial .\}
  2206. End
  2207. Else
  2208. NewDir:='';
  2209. Until (DirList='') or (Length(NewDir) > 0);
  2210. FSearch:=NewDir;
  2211. End;
  2212. End;
  2213. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  2214. Var
  2215. DotPos,SlashPos,i : longint;
  2216. Begin
  2217. SlashPos:=0;
  2218. DotPos:=256;
  2219. i:=Length(Path);
  2220. While (i>0) and (SlashPos=0) Do
  2221. Begin
  2222. If (DotPos=256) and (Path[i]='.') Then
  2223. DotPos:=i;
  2224. If (Path[i]='/') Then
  2225. SlashPos:=i;
  2226. Dec(i);
  2227. End;
  2228. Ext:=Copy(Path,DotPos,255);
  2229. Dir:=Copy(Path,1,SlashPos);
  2230. Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
  2231. End;
  2232. Function Dirname(Const path:pathstr):pathstr;
  2233. {
  2234. This function returns the directory part of a complete path.
  2235. Unless the directory is root '/', The last character is not
  2236. a slash.
  2237. }
  2238. var
  2239. Dir : PathStr;
  2240. Name : NameStr;
  2241. Ext : ExtStr;
  2242. begin
  2243. FSplit(Path,Dir,Name,Ext);
  2244. if length(Dir)>1 then
  2245. Delete(Dir,length(Dir),1);
  2246. DirName:=Dir;
  2247. end;
  2248. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  2249. {
  2250. This function returns the filename part of a complete path. If suf is
  2251. supplied, it is cut off the filename.
  2252. }
  2253. var
  2254. Dir : PathStr;
  2255. Name : NameStr;
  2256. Ext : ExtStr;
  2257. begin
  2258. FSplit(Path,Dir,Name,Ext);
  2259. if Suf<>Ext then
  2260. Name:=Name+Ext;
  2261. BaseName:=Name;
  2262. end;
  2263. Function FNMatch(const Pattern,Name:string):Boolean;
  2264. Var
  2265. LenPat,LenName : longint;
  2266. Function DoFNMatch(i,j:longint):Boolean;
  2267. Var
  2268. Found : boolean;
  2269. Begin
  2270. Found:=true;
  2271. While Found and (i<=LenPat) Do
  2272. Begin
  2273. Case Pattern[i] of
  2274. '?' : Found:=(j<=LenName);
  2275. '*' : Begin
  2276. {find the next character in pattern, different of ? and *}
  2277. while Found and (i<LenPat) do
  2278. begin
  2279. inc(i);
  2280. case Pattern[i] of
  2281. '*' : ;
  2282. '?' : begin
  2283. inc(j);
  2284. Found:=(j<=LenName);
  2285. end;
  2286. else
  2287. Found:=false;
  2288. end;
  2289. end;
  2290. {Now, find in name the character which i points to, if the * or ?
  2291. wasn't the last character in the pattern, else, use up all the
  2292. chars in name}
  2293. Found:=true;
  2294. if (i<=LenPat) then
  2295. begin
  2296. repeat
  2297. {find a letter (not only first !) which maches pattern[i]}
  2298. while (j<=LenName) and (name[j]<>pattern[i]) do
  2299. inc (j);
  2300. if (j<LenName) then
  2301. begin
  2302. if DoFnMatch(i+1,j+1) then
  2303. begin
  2304. i:=LenPat;
  2305. j:=LenName;{we can stop}
  2306. Found:=true;
  2307. end
  2308. else
  2309. inc(j);{We didn't find one, need to look further}
  2310. end;
  2311. until (j>=LenName);
  2312. end
  2313. else
  2314. j:=LenName;{we can stop}
  2315. end;
  2316. else {not a wildcard character in pattern}
  2317. Found:=(j<=LenName) and (pattern[i]=name[j]);
  2318. end;
  2319. inc(i);
  2320. inc(j);
  2321. end;
  2322. DoFnMatch:=Found and (j>LenName);
  2323. end;
  2324. Begin {start FNMatch}
  2325. LenPat:=Length(Pattern);
  2326. LenName:=Length(Name);
  2327. FNMatch:=DoFNMatch(1,1);
  2328. End;
  2329. Procedure Globfree(var p : pglob);
  2330. {
  2331. Release memory occupied by pglob structure, and names in it.
  2332. sets p to nil.
  2333. }
  2334. var
  2335. temp : pglob;
  2336. begin
  2337. while assigned(p) do
  2338. begin
  2339. temp:=p^.next;
  2340. if assigned(p^.name) then
  2341. freemem(p^.name);
  2342. dispose(p);
  2343. p:=temp;
  2344. end;
  2345. end;
  2346. Function Glob(Const path:pathstr):pglob;
  2347. {
  2348. Fills a tglob structure with entries matching path,
  2349. and returns a pointer to it. Returns nil on error,
  2350. linuxerror is set accordingly.
  2351. }
  2352. var
  2353. temp,
  2354. temp2 : string[255];
  2355. thedir : pdir;
  2356. buffer : pdirent;
  2357. root,
  2358. current : pglob;
  2359. begin
  2360. { Get directory }
  2361. temp:=dirname(path);
  2362. if temp='' then
  2363. temp:='.';
  2364. temp:=temp+#0;
  2365. thedir:=opendir(@temp[1]);
  2366. if thedir=nil then
  2367. begin
  2368. glob:=nil;
  2369. linuxerror:=errno;
  2370. exit;
  2371. end;
  2372. temp:=basename(path,''); { get the pattern }
  2373. if thedir^.fd<0 then
  2374. begin
  2375. linuxerror:=errno;
  2376. glob:=nil;
  2377. exit;
  2378. end;
  2379. {get the entries}
  2380. root:=nil;
  2381. current:=nil;
  2382. repeat
  2383. buffer:=Sys_readdir(thedir);
  2384. if buffer=nil then
  2385. break;
  2386. temp2:=strpas(@(buffer^.name[0]));
  2387. if fnmatch(temp,temp2) then
  2388. begin
  2389. if root=nil then
  2390. begin
  2391. new(root);
  2392. current:=root;
  2393. end
  2394. else
  2395. begin
  2396. new(current^.next);
  2397. current:=current^.next;
  2398. end;
  2399. if current=nil then
  2400. begin
  2401. linuxerror:=Sys_ENOMEM;
  2402. globfree(root);
  2403. break;
  2404. end;
  2405. current^.next:=nil;
  2406. getmem(current^.name,length(temp2)+1);
  2407. if current^.name=nil then
  2408. begin
  2409. linuxerror:=Sys_ENOMEM;
  2410. globfree(root);
  2411. break;
  2412. end;
  2413. move(buffer^.name[0],current^.name^,length(temp2)+1);
  2414. end;
  2415. until false;
  2416. closedir(thedir);
  2417. glob:=root;
  2418. end;
  2419. {--------------------------------
  2420. FiledescriptorSets
  2421. --------------------------------}
  2422. Procedure FD_Zero(var fds:fdSet);
  2423. {
  2424. Clear the set of filedescriptors
  2425. }
  2426. begin
  2427. FillChar(fds,sizeof(fdSet),0);
  2428. end;
  2429. Procedure FD_Clr(fd:longint;var fds:fdSet);
  2430. {
  2431. Remove fd from the set of filedescriptors
  2432. }
  2433. begin
  2434. fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
  2435. end;
  2436. Procedure FD_Set(fd:longint;var fds:fdSet);
  2437. {
  2438. Add fd to the set of filedescriptors
  2439. }
  2440. begin
  2441. fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
  2442. end;
  2443. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  2444. {
  2445. Test if fd is part of the set of filedescriptors
  2446. }
  2447. begin
  2448. FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
  2449. end;
  2450. Function GetFS (var T:Text):longint;
  2451. {
  2452. Get File Descriptor of a text file.
  2453. }
  2454. begin
  2455. if textrec(t).mode=fmclosed then
  2456. exit(-1)
  2457. else
  2458. GETFS:=textrec(t).Handle
  2459. end;
  2460. Function GetFS(Var F:File):longint;
  2461. {
  2462. Get File Descriptor of an unTyped file.
  2463. }
  2464. begin
  2465. { Handle and mode are on the same place in textrec and filerec. }
  2466. if filerec(f).mode=fmclosed then
  2467. exit(-1)
  2468. else
  2469. GETFS:=filerec(f).Handle
  2470. end;
  2471. {--------------------------------
  2472. Stat.Mode Macro's
  2473. --------------------------------}
  2474. Function S_ISLNK(m:word):boolean;
  2475. {
  2476. Check mode field of inode for link.
  2477. }
  2478. begin
  2479. S_ISLNK:=(m and STAT_IFMT)=STAT_IFLNK;
  2480. end;
  2481. Function S_ISREG(m:word):boolean;
  2482. {
  2483. Check mode field of inode for regular file.
  2484. }
  2485. begin
  2486. S_ISREG:=(m and STAT_IFMT)=STAT_IFREG;
  2487. end;
  2488. Function S_ISDIR(m:word):boolean;
  2489. {
  2490. Check mode field of inode for directory.
  2491. }
  2492. begin
  2493. S_ISDIR:=(m and STAT_IFMT)=STAT_IFDIR;
  2494. end;
  2495. Function S_ISCHR(m:word):boolean;
  2496. {
  2497. Check mode field of inode for character device.
  2498. }
  2499. begin
  2500. S_ISCHR:=(m and STAT_IFMT)=STAT_IFCHR;
  2501. end;
  2502. Function S_ISBLK(m:word):boolean;
  2503. {
  2504. Check mode field of inode for block device.
  2505. }
  2506. begin
  2507. S_ISBLK:=(m and STAT_IFMT)=STAT_IFBLK;
  2508. end;
  2509. Function S_ISFIFO(m:word):boolean;
  2510. {
  2511. Check mode field of inode for named pipe (FIFO).
  2512. }
  2513. begin
  2514. S_ISFIFO:=(m and STAT_IFMT)=STAT_IFIFO;
  2515. end;
  2516. Function S_ISSOCK(m:word):boolean;
  2517. {
  2518. Check mode field of inode for socket.
  2519. }
  2520. begin
  2521. S_ISSOCK:=(m and STAT_IFMT)=STAT_IFSOCK;
  2522. end;
  2523. {--------------------------------
  2524. Memory functions
  2525. --------------------------------}
  2526. Initialization
  2527. InitLocalTime;
  2528. finalization
  2529. DoneLocalTime;
  2530. End.
  2531. {
  2532. $Log$
  2533. Revision 1.70 2000-05-21 17:10:13 michael
  2534. + AssignStream now always returns PID of spawned process
  2535. Revision 1.69 2000/05/17 17:11:44 peter
  2536. * added sigaction record from signal.inc
  2537. Revision 1.68 2000/04/16 16:09:32 marco
  2538. * Some small mistakes when merging BSD and Linux version fixed
  2539. Revision 1.67 2000/04/14 16:07:06 marco
  2540. * Splitted linux into linux.pp and linsysca.inc, and merged BSD diffs
  2541. into header
  2542. Revision 1.66 2000/03/27 13:25:48 jonas
  2543. * fixed readport* functions (thanks Florian ;)
  2544. Revision 1.65 2000/03/23 17:10:32 jonas
  2545. * fixes for port reading
  2546. Revision 1.64 2000/03/17 13:27:00 sg
  2547. * Added WritePort[B|W|L] for single data access
  2548. * Added ReadPort[B|W|L] functions
  2549. Revision 1.63 2000/02/23 17:19:06 peter
  2550. + readded getepochtime which simply calls gettimeofday
  2551. Revision 1.62 2000/02/09 23:09:13 peter
  2552. * rewrote glob to be much simpler and cleaner, the old code did
  2553. strange complex things with pointers which was unnecessary
  2554. Revision 1.61 2000/02/09 16:59:31 peter
  2555. * truncated log
  2556. Revision 1.60 2000/02/08 12:05:58 peter
  2557. + readlink
  2558. Revision 1.59 2000/01/07 16:41:40 daniel
  2559. * copyright 2000
  2560. Revision 1.58 2000/01/07 16:32:26 daniel
  2561. * copyright 2000 added
  2562. Revision 1.57 2000/01/04 12:56:09 jonas
  2563. * fixed modified registers for port routines
  2564. Revision 1.56 1999/12/28 09:38:07 sg
  2565. * the long version of AssignStream now sets the result value to -1 in
  2566. _all_ cases when it would fail.
  2567. Revision 1.55 1999/12/08 01:03:54 peter
  2568. * overloaded gettime functions supporting hsec and msec,usec
  2569. Revision 1.54 1999/12/01 22:46:59 peter
  2570. + timezone support
  2571. Revision 1.53 1999/11/14 21:35:04 peter
  2572. * removed warnings
  2573. Revision 1.52 1999/11/14 11:11:15 michael
  2574. + Added Pause() and alarm()
  2575. Revision 1.51 1999/11/11 19:43:49 sg
  2576. * fixed severe bug: change by ? in dup2 (flushing) resulted in broken
  2577. AssignStream functions
  2578. Revision 1.50 1999/11/06 14:39:12 peter
  2579. * truncated log
  2580. Revision 1.49 1999/10/28 09:48:31 peter
  2581. + mmap
  2582. Revision 1.48 1999/10/22 10:37:44 peter
  2583. * fixed sigset
  2584. Revision 1.47 1999/10/06 17:43:58 peter
  2585. * freemem with wrong size (found with the new heapmanager)
  2586. Revision 1.46 1999/09/08 16:14:41 peter
  2587. * pointer fixes
  2588. Revision 1.45 1999/08/11 22:02:25 peter
  2589. * removed old integer versions of localtoepoch and epochtolocal, you
  2590. need to use the word versions instead else you got an overloaded bug
  2591. Revision 1.44 1999/07/31 23:55:04 michael
  2592. + FCNTL patch from Sebastian Guenther
  2593. Revision 1.43 1999/07/29 16:33:24 michael
  2594. + Yet more Fixes to assignstream with rerouting of stderr
  2595. Revision 1.42 1999/07/29 15:55:54 michael
  2596. + Fixes to assignstream with rerouting of stderr, by Sebastian Guenther
  2597. Revision 1.41 1999/07/29 15:53:55 michael
  2598. + Added assignstream with rerouting of stderr, by Sebastian Guenther
  2599. }