linux.pp 67 KB

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