linux.pp 86 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011
  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. member of the Free Pascal development team.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY;without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. Unit Linux;
  13. Interface
  14. { Get Types and Constants }
  15. {$i sysconst.inc}
  16. {$i systypes.inc}
  17. { Get System call numbers and error-numbers}
  18. {$i sysnr.inc}
  19. {$i errno.inc}
  20. var
  21. ErrNo,
  22. LinuxError : Longint;
  23. {********************
  24. Process
  25. ********************}
  26. const
  27. { cloning flags }
  28. CSIGNAL = $000000ff; // signal mask to be sent at exit
  29. CLONE_VM = $00000100; // set if VM shared between processes
  30. CLONE_FS = $00000200; // set if fs info shared between processes
  31. CLONE_FILES = $00000400; // set if open files shared between processes
  32. CLONE_SIGHAND = $00000800; // set if signal handlers shared
  33. CLONE_PID = $00001000; // set if pid shared
  34. type
  35. TCloneFunc=function(args:pointer):longint;cdecl;
  36. const
  37. { For getting/setting priority }
  38. Prio_Process = 0;
  39. Prio_PGrp = 1;
  40. Prio_User = 2;
  41. WNOHANG = $1;
  42. WUNTRACED = $2;
  43. __WCLONE = $80000000;
  44. {********************
  45. File
  46. ********************}
  47. Const
  48. P_IN = 1;
  49. P_OUT = 2;
  50. Const
  51. LOCK_SH = 1;
  52. LOCK_EX = 2;
  53. LOCK_UN = 8;
  54. LOCK_NB = 4;
  55. Type
  56. Tpipe = array[1..2] of longint;
  57. pglob = ^tglob;
  58. tglob = record
  59. name : pchar;
  60. next : pglob;
  61. end;
  62. ComStr = String[255];
  63. PathStr = String[255];
  64. DirStr = String[255];
  65. NameStr = String[255];
  66. ExtStr = String[255];
  67. const
  68. { For testing access rights }
  69. R_OK = 4;
  70. W_OK = 2;
  71. X_OK = 1;
  72. F_OK = 0;
  73. { For File control mechanism }
  74. F_GetFd = 1;
  75. F_SetFd = 2;
  76. F_GetFl = 3;
  77. F_SetFl = 4;
  78. F_GetLk = 5;
  79. F_SetLk = 6;
  80. F_SetLkW = 7;
  81. F_GetOwn = 8;
  82. F_SetOwn = 9;
  83. {********************
  84. Signal
  85. ********************}
  86. Const
  87. { For sending a signal }
  88. SA_NOCLDSTOP = 1;
  89. SA_SHIRQ = $04000000;
  90. SA_STACK = $08000000;
  91. SA_RESTART = $10000000;
  92. SA_INTERRUPT = $20000000;
  93. SA_NOMASK = $40000000;
  94. SA_ONESHOT = $80000000;
  95. SIG_BLOCK = 0;
  96. SIG_UNBLOCK = 1;
  97. SIG_SETMASK = 2;
  98. SIG_DFL = 0 ;
  99. SIG_IGN = 1 ;
  100. SIG_ERR = -1 ;
  101. SIGHUP = 1;
  102. SIGINT = 2;
  103. SIGQUIT = 3;
  104. SIGILL = 4;
  105. SIGTRAP = 5;
  106. SIGABRT = 6;
  107. SIGIOT = 6;
  108. SIGBUS = 7;
  109. SIGFPE = 8;
  110. SIGKILL = 9;
  111. SIGUSR1 = 10;
  112. SIGSEGV = 11;
  113. SIGUSR2 = 12;
  114. SIGPIPE = 13;
  115. SIGALRM = 14;
  116. SIGTerm = 15;
  117. SIGSTKFLT = 16;
  118. SIGCHLD = 17;
  119. SIGCONT = 18;
  120. SIGSTOP = 19;
  121. SIGTSTP = 20;
  122. SIGTTIN = 21;
  123. SIGTTOU = 22;
  124. SIGURG = 23;
  125. SIGXCPU = 24;
  126. SIGXFSZ = 25;
  127. SIGVTALRM = 26;
  128. SIGPROF = 27;
  129. SIGWINCH = 28;
  130. SIGIO = 29;
  131. SIGPOLL = SIGIO;
  132. SIGPWR = 30;
  133. SIGUNUSED = 31;
  134. Type
  135. SignalHandler = Procedure(Sig : LongInt);cdecl;
  136. PSignalHandler = ^SignalHandler;
  137. SignalRestorer = Procedure;cdecl;
  138. PSignalRestorer = ^SignalRestorer;
  139. SigSet = Longint;
  140. PSigSet = ^SigSet;
  141. SigActionRec = packed record
  142. Sa_Handler : SignalHandler;
  143. Sa_Mask : SigSet;
  144. Sa_Flags : Longint;
  145. Sa_restorer : SignalRestorer; { Obsolete - Don't use }
  146. end;
  147. PSigActionRec = ^SigActionRec;
  148. {********************
  149. IOCtl(TermIOS)
  150. ********************}
  151. Const
  152. { Amount of Control Chars }
  153. NCCS = 19;
  154. NCC = 8;
  155. { For Terminal handling }
  156. TCGETS = $5401;
  157. TCSETS = $5402;
  158. TCSETSW = $5403;
  159. TCSETSF = $5404;
  160. TCGETA = $5405;
  161. TCSETA = $5406;
  162. TCSETAW = $5407;
  163. TCSETAF = $5408;
  164. TCSBRK = $5409;
  165. TCXONC = $540A;
  166. TCFLSH = $540B;
  167. TIOCEXCL = $540C;
  168. TIOCNXCL = $540D;
  169. TIOCSCTTY = $540E;
  170. TIOCGPGRP = $540F;
  171. TIOCSPGRP = $5410;
  172. TIOCOUTQ = $5411;
  173. TIOCSTI = $5412;
  174. TIOCGWINSZ = $5413;
  175. TIOCSWINSZ = $5414;
  176. TIOCMGET = $5415;
  177. TIOCMBIS = $5416;
  178. TIOCMBIC = $5417;
  179. TIOCMSET = $5418;
  180. TIOCGSOFTCAR = $5419;
  181. TIOCSSOFTCAR = $541A;
  182. FIONREAD = $541B;
  183. TIOCINQ = FIONREAD;
  184. TIOCLINUX = $541C;
  185. TIOCCONS = $541D;
  186. TIOCGSERIAL = $541E;
  187. TIOCSSERIAL = $541F;
  188. TIOCPKT = $5420;
  189. FIONBIO = $5421;
  190. TIOCNOTTY = $5422;
  191. TIOCSETD = $5423;
  192. TIOCGETD = $5424;
  193. TCSBRKP = $5425;
  194. TIOCTTYGSTRUCT = $5426;
  195. FIONCLEX = $5450;
  196. FIOCLEX = $5451;
  197. FIOASYNC = $5452;
  198. TIOCSERCONFIG = $5453;
  199. TIOCSERGWILD = $5454;
  200. TIOCSERSWILD = $5455;
  201. TIOCGLCKTRMIOS = $5456;
  202. TIOCSLCKTRMIOS = $5457;
  203. TIOCSERGSTRUCT = $5458;
  204. TIOCSERGETLSR = $5459;
  205. TIOCSERGETMULTI = $545A;
  206. TIOCSERSETMULTI = $545B;
  207. TIOCMIWAIT = $545C;
  208. TIOCGICOUNT = $545D;
  209. TIOCPKT_DATA = 0;
  210. TIOCPKT_FLUSHREAD = 1;
  211. TIOCPKT_FLUSHWRITE = 2;
  212. TIOCPKT_STOP = 4;
  213. TIOCPKT_START = 8;
  214. TIOCPKT_NOSTOP = 16;
  215. TIOCPKT_DOSTOP = 32;
  216. Type
  217. winsize = packed record
  218. ws_row,
  219. ws_col,
  220. ws_xpixel,
  221. ws_ypixel : word;
  222. end;
  223. TWinSize=winsize;
  224. Termio = packed record
  225. c_iflag, { input mode flags }
  226. c_oflag, { output mode flags }
  227. c_cflag, { control mode flags }
  228. c_lflag : Word; { local mode flags }
  229. c_line : Word; { line discipline - careful, only High byte in use}
  230. c_cc : array [0..NCC-1] of char;{ control characters }
  231. end;
  232. TTermio=Termio;
  233. Termios = packed record
  234. c_iflag,
  235. c_oflag,
  236. c_cflag,
  237. c_lflag : longint;
  238. c_line : char;
  239. c_cc : array[0..NCCS-1] of byte;
  240. end;
  241. TTermios=Termios;
  242. const
  243. 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);
  244. const
  245. {c_cc characters}
  246. VINTR = 0;
  247. VQUIT = 1;
  248. VERASE = 2;
  249. VKILL = 3;
  250. VEOF = 4;
  251. VTIME = 5;
  252. VMIN = 6;
  253. VSWTC = 7;
  254. VSTART = 8;
  255. VSTOP = 9;
  256. VSUSP = 10;
  257. VEOL = 11;
  258. VREPRINT = 12;
  259. VDISCARD = 13;
  260. VWERASE = 14;
  261. VLNEXT = 15;
  262. VEOL2 = 16;
  263. {c_iflag bits}
  264. IGNBRK = $0000001;
  265. BRKINT = $0000002;
  266. IGNPAR = $0000004;
  267. PARMRK = $0000008;
  268. INPCK = $0000010;
  269. ISTRIP = $0000020;
  270. INLCR = $0000040;
  271. IGNCR = $0000080;
  272. ICRNL = $0000100;
  273. IUCLC = $0000200;
  274. IXON = $0000400;
  275. IXANY = $0000800;
  276. IXOFF = $0001000;
  277. IMAXBEL = $0002000;
  278. {c_oflag bits}
  279. OPOST = $0000001;
  280. OLCUC = $0000002;
  281. ONLCR = $0000004;
  282. OCRNL = $0000008;
  283. ONOCR = $0000010;
  284. ONLRET = $0000020;
  285. OFILL = $0000040;
  286. OFDEL = $0000080;
  287. NLDLY = $0000100;
  288. NL0 = $0000000;
  289. NL1 = $0000100;
  290. CRDLY = $0000600;
  291. CR0 = $0000000;
  292. CR1 = $0000200;
  293. CR2 = $0000400;
  294. CR3 = $0000600;
  295. TABDLY = $0001800;
  296. TAB0 = $0000000;
  297. TAB1 = $0000800;
  298. TAB2 = $0001000;
  299. TAB3 = $0001800;
  300. XTABS = $0001800;
  301. BSDLY = $0002000;
  302. BS0 = $0000000;
  303. BS1 = $0002000;
  304. VTDLY = $0004000;
  305. VT0 = $0000000;
  306. VT1 = $0004000;
  307. FFDLY = $0008000;
  308. FF0 = $0000000;
  309. FF1 = $0008000;
  310. {c_cflag bits}
  311. CBAUD = $000100F;
  312. B0 = $0000000;
  313. B50 = $0000001;
  314. B75 = $0000002;
  315. B110 = $0000003;
  316. B134 = $0000004;
  317. B150 = $0000005;
  318. B200 = $0000006;
  319. B300 = $0000007;
  320. B600 = $0000008;
  321. B1200 = $0000009;
  322. B1800 = $000000A;
  323. B2400 = $000000B;
  324. B4800 = $000000C;
  325. B9600 = $000000D;
  326. B19200 = $000000E;
  327. B38400 = $000000F;
  328. EXTA = B19200;
  329. EXTB = B38400;
  330. CSIZE = $0000030;
  331. CS5 = $0000000;
  332. CS6 = $0000010;
  333. CS7 = $0000020;
  334. CS8 = $0000030;
  335. CSTOPB = $0000040;
  336. CREAD = $0000080;
  337. PARENB = $0000100;
  338. PARODD = $0000200;
  339. HUPCL = $0000400;
  340. CLOCAL = $0000800;
  341. CBAUDEX = $0001000;
  342. B57600 = $0001001;
  343. B115200 = $0001002;
  344. B230400 = $0001003;
  345. B460800 = $0001004;
  346. CIBAUD = $100F0000;
  347. CMSPAR = $40000000;
  348. CRTSCTS = $80000000;
  349. {c_lflag bits}
  350. ISIG = $0000001;
  351. ICANON = $0000002;
  352. XCASE = $0000004;
  353. ECHO = $0000008;
  354. ECHOE = $0000010;
  355. ECHOK = $0000020;
  356. ECHONL = $0000040;
  357. NOFLSH = $0000080;
  358. TOSTOP = $0000100;
  359. ECHOCTL = $0000200;
  360. ECHOPRT = $0000400;
  361. ECHOKE = $0000800;
  362. FLUSHO = $0001000;
  363. PENDIN = $0004000;
  364. IEXTEN = $0008000;
  365. {c_line bits}
  366. TIOCM_LE = $001;
  367. TIOCM_DTR = $002;
  368. TIOCM_RTS = $004;
  369. TIOCM_ST = $008;
  370. TIOCM_SR = $010;
  371. TIOCM_CTS = $020;
  372. TIOCM_CAR = $040;
  373. TIOCM_RNG = $080;
  374. TIOCM_DSR = $100;
  375. TIOCM_CD = TIOCM_CAR;
  376. TIOCM_RI = TIOCM_RNG;
  377. TIOCM_OUT1 = $2000;
  378. TIOCM_OUT2 = $4000;
  379. {TCSetAttr}
  380. TCSANOW = 0;
  381. TCSADRAIN = 1;
  382. TCSAFLUSH = 2;
  383. {TCFlow}
  384. TCOOFF = 0;
  385. TCOON = 1;
  386. TCIOFF = 2;
  387. TCION = 3;
  388. {TCFlush}
  389. TCIFLUSH = 0;
  390. TCOFLUSH = 1;
  391. TCIOFLUSH = 2;
  392. {********************
  393. Info
  394. ********************}
  395. Type
  396. UTimBuf = packed record
  397. actime,modtime : Longint;
  398. end;
  399. UTimeBuf=UTimBuf;
  400. TUTimeBuf=UTimeBuf;
  401. PUTimeBuf=^UTimeBuf;
  402. TSysinfo = packed record
  403. uptime : longint;
  404. loads : array[1..3] of longint;
  405. totalram,
  406. freeram,
  407. sharedram,
  408. bufferram,
  409. totalswap,
  410. freeswap : longint;
  411. procs : integer;
  412. s : string[18];
  413. end;
  414. PSysInfo = ^TSysInfo;
  415. {******************************************************************************
  416. Procedure/Functions
  417. ******************************************************************************}
  418. Function SysCall(callnr:longint;var regs:SysCallregs):longint;
  419. {**************************
  420. Time/Date Handling
  421. ***************************}
  422. var
  423. tzdaylight : boolean;
  424. tzseconds : longint;
  425. tzname : array[boolean] of pchar;
  426. { timezone support }
  427. procedure GetLocalTimezone(timer:longint;var leap_correct,leap_hit:longint);
  428. procedure GetLocalTimezone(timer:longint);
  429. procedure ReadTimezoneFile(fn:string);
  430. function GetTimezoneFile:string;
  431. Procedure GetTimeOfDay(var tv:timeval);
  432. Function GetTimeOfDay:longint;
  433. Function GetEpochTime: longint;
  434. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  435. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  436. procedure GetTime(var hour,min,sec,msec,usec:word);
  437. procedure GetTime(var hour,min,sec,sec100:word);
  438. procedure GetTime(var hour,min,sec:word);
  439. Procedure GetDate(Var Year,Month,Day:Word);
  440. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  441. {**************************
  442. Process Handling
  443. ***************************}
  444. function CreateShellArgV(const prog:string):ppchar;
  445. function CreateShellArgV(const prog:Ansistring):ppchar;
  446. Procedure Execve(Path:pathstr;args:ppchar;ep:ppchar);
  447. Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
  448. Procedure Execv(const path:pathstr;args:ppchar);
  449. Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
  450. Procedure Execl(const Todo:string);
  451. Procedure Execle(Todo:string;Ep:ppchar);
  452. Procedure Execlp(Todo:string;Ep:ppchar);
  453. Function Shell(const Command:String):Longint;
  454. Function Shell(const Command:AnsiString):Longint;
  455. Function Fork:longint;
  456. function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
  457. Procedure ExitProcess(val:longint);
  458. Function WaitPid(Pid:longint;Status:pointer;Options:Integer):Longint;
  459. Procedure Nice(N:integer);
  460. Function GetPriority(Which,Who:Integer):integer;
  461. Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
  462. Function GetPid:LongInt;
  463. Function GetPPid:LongInt;
  464. Function GetUid:Longint;
  465. Function GetEUid:Longint;
  466. Function GetGid:Longint;
  467. Function GetEGid:Longint;
  468. {**************************
  469. File Handling
  470. ***************************}
  471. Function fdOpen(pathname:string;flags:longint):longint;
  472. Function fdOpen(pathname:string;flags,mode:longint):longint;
  473. Function fdOpen(pathname:pchar;flags:longint):longint;
  474. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  475. Function fdClose(fd:longint):boolean;
  476. Function fdRead(fd:longint;var buf;size:longint):longint;
  477. Function fdWrite(fd:longint;var buf;size:longint):longint;
  478. Function fdTruncate(fd,size:longint):boolean;
  479. Function fdSeek (fd,pos,seektype :longint): longint;
  480. Function fdFlush (fd : Longint) : Boolean;
  481. Function Link(OldPath,NewPath:pathstr):boolean;
  482. Function SymLink(OldPath,NewPath:pathstr):boolean;
  483. Function ReadLink(name,linkname:pchar;maxlen:longint):longint;
  484. Function ReadLink(name:pathstr):pathstr;
  485. Function UnLink(Path:pathstr):boolean;
  486. Function UnLink(Path:pchar):Boolean;
  487. Function FReName (OldName,NewName : Pchar) : Boolean;
  488. Function FReName (OldName,NewName : String) : Boolean;
  489. Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
  490. Function Chmod(path:pathstr;Newmode:longint):boolean;
  491. Function Utime(path:pathstr;utim:utimebuf):boolean;
  492. Function Access(Path:Pathstr ;mode:integer):boolean;
  493. Function Umask(Mask:Integer):integer;
  494. Function Flock (fd,mode : longint) : boolean;
  495. Function Flock (var T : text;mode : longint) : boolean;
  496. Function Flock (var F : File;mode : longint) : boolean;
  497. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  498. Function FStat(Fd:longint;Var Info:stat):Boolean;
  499. Function FStat(var F:Text;Var Info:stat):Boolean;
  500. Function FStat(var F:File;Var Info:stat):Boolean;
  501. Function Lstat(Filename: PathStr;var Info:stat):Boolean;
  502. Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
  503. Function FSStat(Fd: Longint;Var Info:statfs):Boolean;
  504. Function Fcntl(Fd:longint;Cmd:Integer):integer;
  505. Procedure Fcntl(Fd:longint;Cmd:Integer;Arg:Longint);
  506. Function Fcntl(var Fd:Text;Cmd:Integer):integer;
  507. Procedure Fcntl(var Fd:Text;Cmd:Integer;Arg:Longint);
  508. Function Dup(oldfile:longint;var newfile:longint):Boolean;
  509. Function Dup(var oldfile,newfile:text):Boolean;
  510. Function Dup(var oldfile,newfile:file):Boolean;
  511. Function Dup2(oldfile,newfile:longint):Boolean;
  512. Function Dup2(var oldfile,newfile:text):Boolean;
  513. Function Dup2(var oldfile,newfile:file):Boolean;
  514. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
  515. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  516. Function SelectText(var T:Text;TimeOut :PTimeVal):Longint;
  517. {**************************
  518. Directory Handling
  519. ***************************}
  520. Function OpenDir(f:pchar):pdir;
  521. Function OpenDir(f: String):pdir;
  522. function CloseDir(p:pdir):integer;
  523. Function ReadDir(p:pdir):pdirent;
  524. procedure SeekDir(p:pdir;off:longint);
  525. function TellDir(p:pdir):longint;
  526. {**************************
  527. Pipe/Fifo/Stream
  528. ***************************}
  529. Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
  530. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  531. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  532. Function PClose(Var F:text) : longint;
  533. Function PClose(Var F:file) : longint;
  534. Procedure POpen(var F:text;const Prog:String;rw:char);
  535. Procedure POpen(var F:file;const Prog:String;rw:char);
  536. Function mkFifo(pathname:string;mode:longint):boolean;
  537. Procedure AssignStream(Var StreamIn,Streamout:text;Const Prog:String);
  538. function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
  539. {**************************
  540. General information
  541. ***************************}
  542. Function GetDomainName:String;
  543. Function GetHostName:String;
  544. Function GetEnv(P:string):Pchar;
  545. Function Sysinfo(var Info:TSysinfo):Boolean;
  546. Function Uname(var unamerec:utsname):Boolean;
  547. {**************************
  548. Signal
  549. ***************************}
  550. Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
  551. Procedure SigProcMask (How:Integer;SSet,OldSSet:PSigSet);
  552. Function SigPending:SigSet;
  553. Procedure SigSuspend(Mask:Sigset);
  554. Function Signal(Signum:Integer;Handler:SignalHandler):SignalHandler;
  555. Function Kill(Pid:longint;Sig:integer):integer;
  556. Procedure SigRaise(Sig:integer);
  557. Function Alarm(Sec : Longint) : longint;
  558. Procedure Pause;
  559. {**************************
  560. IOCtl/Termios Functions
  561. ***************************}
  562. Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
  563. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  564. Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
  565. Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
  566. Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
  567. Procedure CFMakeRaw(var tios:TermIOS);
  568. Function TCSendBreak(fd,duration:longint):boolean;
  569. Function TCSetPGrp(fd,id:longint):boolean;
  570. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  571. Function TCFlush(fd,qsel:longint):boolean;
  572. Function TCDrain(fd:longint):boolean;
  573. Function TCFlow(fd,act:longint):boolean;
  574. Function IsATTY(Handle:Longint):Boolean;
  575. Function IsATTY(f:text):Boolean;
  576. function TTYname(Handle:Longint):string;
  577. function TTYname(var F:Text):string;
  578. {**************************
  579. Memory functions
  580. ***************************}
  581. const
  582. PROT_READ = $1; { page can be read }
  583. PROT_WRITE = $2; { page can be written }
  584. PROT_EXEC = $4; { page can be executed }
  585. PROT_NONE = $0; { page can not be accessed }
  586. MAP_SHARED = $1; { Share changes }
  587. MAP_PRIVATE = $2; { Changes are private }
  588. MAP_TYPE = $f; { Mask for type of mapping }
  589. MAP_FIXED = $10; { Interpret addr exactly }
  590. MAP_ANONYMOUS = $20; { don't use a file }
  591. MAP_GROWSDOWN = $100; { stack-like segment }
  592. MAP_DENYWRITE = $800; { ETXTBSY }
  593. MAP_EXECUTABLE = $1000; { mark it as an executable }
  594. MAP_LOCKED = $2000; { pages are locked }
  595. MAP_NORESERVE = $4000; { don't check for reservations }
  596. type
  597. tmmapargs=record
  598. address : longint;
  599. size : longint;
  600. prot : longint;
  601. flags : longint;
  602. fd : longint;
  603. offset : longint;
  604. end;
  605. function MMap(const m:tmmapargs):longint;
  606. {**************************
  607. Port IO functions
  608. ***************************}
  609. Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
  610. {$IFDEF I386}
  611. Procedure WritePort (Port : Longint; Value : Byte);
  612. Procedure WritePort (Port : Longint; Value : Word);
  613. Procedure WritePort (Port : Longint; Value : Longint);
  614. Procedure WritePortB (Port : Longint; Value : Byte);
  615. Procedure WritePortW (Port : Longint; Value : Word);
  616. Procedure WritePortL (Port : Longint; Value : Longint);
  617. Procedure WritePortL (Port : Longint; Var Buf; Count: longint);
  618. Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
  619. Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
  620. Procedure ReadPort (Port : Longint; Var Value : Byte);
  621. Procedure ReadPort (Port : Longint; Var Value : Word);
  622. Procedure ReadPort (Port : Longint; Var Value : Longint);
  623. function ReadPortB (Port : Longint): Byte;
  624. function ReadPortW (Port : Longint): Word;
  625. function ReadPortL (Port : Longint): LongInt;
  626. Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
  627. Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
  628. Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
  629. {$ENDIF}
  630. {**************************
  631. Utility functions
  632. ***************************}
  633. Function Octal(l:longint):longint;
  634. Function FExpand(Const Path: PathStr):PathStr;
  635. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  636. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  637. Function Dirname(Const path:pathstr):pathstr;
  638. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  639. Function FNMatch(const Pattern,Name:string):Boolean;
  640. Function Glob(Const path:pathstr):pglob;
  641. Procedure Globfree(var p:pglob);
  642. Function StringToPPChar(Var S:STring):ppchar;
  643. Function GetFS(var T:Text):longint;
  644. Function GetFS(Var F:File):longint;
  645. {Filedescriptorsets}
  646. Procedure FD_Zero(var fds:fdSet);
  647. Procedure FD_Clr(fd:longint;var fds:fdSet);
  648. Procedure FD_Set(fd:longint;var fds:fdSet);
  649. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  650. {Stat.Mode Types}
  651. Function S_ISLNK(m:word):boolean;
  652. Function S_ISREG(m:word):boolean;
  653. Function S_ISDIR(m:word):boolean;
  654. Function S_ISCHR(m:word):boolean;
  655. Function S_ISBLK(m:word):boolean;
  656. Function S_ISFIFO(m:word):boolean;
  657. Function S_ISSOCK(m:word):boolean;
  658. {******************************************************************************
  659. Implementation
  660. ******************************************************************************}
  661. Implementation
  662. Uses Strings;
  663. { Get the definitions of textrec and filerec }
  664. {$i textrec.inc}
  665. {$i filerec.inc}
  666. { Raw System calls are in Syscalls.inc}
  667. {$i syscalls.inc}
  668. {******************************************************************************
  669. Process related calls
  670. ******************************************************************************}
  671. function CreateShellArgV(const prog:string):ppchar;
  672. {
  673. Create an argv which executes a command in a shell using /bin/sh -c
  674. }
  675. var
  676. pp,p : ppchar;
  677. temp : string;
  678. begin
  679. getmem(pp,4*4);
  680. temp:='/bin/sh'#0'-c'#0+prog+#0;
  681. p:=pp;
  682. p^:=@temp[1];
  683. inc(p);
  684. p^:=@temp[9];
  685. inc(p);
  686. p^:=@temp[12];
  687. inc(p);
  688. p^:=Nil;
  689. CreateShellArgV:=pp;
  690. end;
  691. function CreateShellArgV(const prog:Ansistring):ppchar;
  692. {
  693. Create an argv which executes a command in a shell using /bin/sh -c
  694. using a AnsiString;
  695. }
  696. var
  697. pp,p : ppchar;
  698. temp : AnsiString;
  699. begin
  700. getmem(pp,4*4);
  701. temp:='/bin/sh'#0'-c'#0+prog+#0;
  702. p:=pp;
  703. GetMem(p^,Length(Temp));
  704. Move(@Temp[1],p^^,Length(Temp));
  705. inc(p);
  706. p^:=@pp[0][8];
  707. inc(p);
  708. p^:=@pp[0][11];
  709. inc(p);
  710. p^:=Nil;
  711. CreateShellArgV:=pp;
  712. end;
  713. Function Fork:longint;
  714. {
  715. This function issues the 'fork' System call. the program is duplicated in memory
  716. and Execution continues in parent and child process.
  717. In the parent process, fork returns the PID of the child. In the child process,
  718. zero is returned.
  719. A negative value indicates that an error has occurred, the error is returned in
  720. LinuxError.
  721. }
  722. var
  723. regs:SysCallregs;
  724. begin
  725. Fork:=SysCall(SysCall_nr_fork,regs);
  726. LinuxError:=Errno;
  727. End;
  728. function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
  729. begin
  730. if (pointer(func)=nil) or (sp=nil) then
  731. begin
  732. LinuxError:=Sys_EInval;
  733. exit;
  734. end;
  735. asm
  736. { Insert the argument onto the new stack. }
  737. movl sp,%ecx
  738. subl $8,%ecx
  739. movl args,%eax
  740. movl %eax,4(%ecx)
  741. { Save the function pointer as the zeroth argument.
  742. It will be popped off in the child in the ebx frobbing below. }
  743. movl func,%eax
  744. movl %eax,0(%ecx)
  745. { Do the system call }
  746. pushl %ebx
  747. movl flags,%ebx
  748. movl SysCall_nr_clone,%eax
  749. int $0x80
  750. popl %ebx
  751. test %eax,%eax
  752. jnz .Lclone_end
  753. { We're in the new thread }
  754. subl %ebp,%ebp { terminate the stack frame }
  755. call *%ebx
  756. { exit process }
  757. movl %eax,%ebx
  758. movl $1,%eax
  759. int $0x80
  760. .Lclone_end:
  761. movl %eax,__RESULT
  762. end;
  763. end;
  764. Procedure Execve(path:pathstr;args:ppchar;ep:ppchar);
  765. {
  766. Replaces the current program by the program specified in path,
  767. arguments in args are passed to Execve.
  768. environment specified in ep is passed on.
  769. }
  770. var
  771. regs:SysCallregs;
  772. begin
  773. path:=path+#0;
  774. regs.reg2:=longint(@path[1]);
  775. regs.reg3:=longint(args);
  776. regs.reg4:=longint(ep);
  777. SysCall(SysCall_nr_Execve,regs);
  778. { This only gets set when the call fails, otherwise we don't get here ! }
  779. Linuxerror:=errno;
  780. end;
  781. Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
  782. {
  783. Replaces the current program by the program specified in path,
  784. arguments in args are passed to Execve.
  785. environment specified in ep is passed on.
  786. }
  787. var
  788. regs:SysCallregs;
  789. begin
  790. regs.reg2:=longint(path);
  791. regs.reg3:=longint(args);
  792. regs.reg4:=longint(ep);
  793. SysCall(SysCall_nr_Execve,regs);
  794. { This only gets set when the call fails, otherwise we don't get here ! }
  795. Linuxerror:=errno;
  796. end;
  797. Procedure Execv(const path:pathstr;args:ppchar);
  798. {
  799. Replaces the current program by the program specified in path,
  800. arguments in args are passed to Execve.
  801. the current environment is passed on.
  802. }
  803. begin
  804. Execve(path,args,envp); {On error linuxerror will get set there}
  805. end;
  806. Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
  807. {
  808. This does the same as Execve, only it searches the PATH environment
  809. for the place of the Executable, except when Path starts with a slash.
  810. if the PATH environment variable is unavailable, the path is set to '.'
  811. }
  812. var
  813. thepath : string;
  814. begin
  815. if path[1]<>'/' then
  816. begin
  817. Thepath:=strpas(getenv('PATH'));
  818. if thepath='' then
  819. thepath:='.';
  820. Path:=FSearch(path,thepath)
  821. end
  822. else
  823. Path:='';
  824. if Path='' then
  825. linuxerror:=Sys_enoent
  826. else
  827. Execve(Path,args,ep);{On error linuxerror will get set there}
  828. end;
  829. Procedure Execle(Todo:string;Ep:ppchar);
  830. {
  831. This procedure takes the string 'Todo', parses it for command and
  832. command options, and Executes the command with the given options.
  833. The string 'Todo' shoud be of the form 'command options', options
  834. separated by commas.
  835. the PATH environment is not searched for 'command'.
  836. The specified environment(in 'ep') is passed on to command
  837. }
  838. var
  839. p : ppchar;
  840. begin
  841. p:=StringToPPChar(ToDo);
  842. if (p=nil) or (p^=nil) then
  843. exit;
  844. ExecVE(p^,p,EP);
  845. end;
  846. Procedure Execl(const Todo:string);
  847. {
  848. This procedure takes the string 'Todo', parses it for command and
  849. command options, and Executes the command with the given options.
  850. The string 'Todo' shoud be of the form 'command options', options
  851. separated by commas.
  852. the PATH environment is not searched for 'command'.
  853. The current environment is passed on to command
  854. }
  855. begin
  856. ExecLE(ToDo,EnvP);
  857. end;
  858. Procedure Execlp(Todo:string;Ep:ppchar);
  859. {
  860. This procedure takes the string 'Todo', parses it for command and
  861. command options, and Executes the command with the given options.
  862. The string 'Todo' shoud be of the form 'command options', options
  863. separated by commas.
  864. the PATH environment is searched for 'command'.
  865. The specified environment (in 'ep') is passed on to command
  866. }
  867. var
  868. p : ppchar;
  869. begin
  870. p:=StringToPPchar(todo);
  871. if (p=nil) or (p^=nil) then
  872. exit;
  873. ExecVP(StrPas(p^),p,EP);
  874. end;
  875. Procedure ExitProcess(val:longint);
  876. var
  877. regs : SysCallregs;
  878. begin
  879. regs.reg2:=val;
  880. SysCall(SysCall_nr_exit,regs);
  881. end;
  882. Function WaitPid(Pid:longint;Status:pointer;Options:Integer):Longint;
  883. {
  884. Waits until a child with PID Pid exits, or returns if it is exited already.
  885. Any resources used by the child are freed.
  886. The exit status is reported in the adress referred to by Status. It should
  887. be a longint.
  888. }
  889. var
  890. regs : SysCallregs;
  891. begin
  892. regs.reg2:=pid;
  893. regs.reg3:=longint(status);
  894. regs.reg4:=options;
  895. WaitPid:=SysCall(SysCall_nr_waitpid,regs);
  896. LinuxError:=errno;
  897. end;
  898. Function Shell(const Command:String):Longint;
  899. {
  900. Executes the shell, and passes it the string Command. (Through /bin/sh -c)
  901. The current environment is passed to the shell.
  902. It waits for the shell to exit, and returns its exit status.
  903. If the Exec call failed exit status 127 is reported.
  904. }
  905. var
  906. p : ppchar;
  907. temp,pid : longint;
  908. begin
  909. pid:=fork;
  910. if pid=-1 then
  911. exit; {Linuxerror already set in Fork}
  912. if pid=0 then
  913. begin
  914. {This is the child.}
  915. p:=CreateShellArgv(command);
  916. Execve(p^,p,envp);
  917. exit(127);
  918. end;
  919. temp:=0;
  920. WaitPid(pid,@temp,0);{Linuxerror is set there}
  921. Shell:=temp;{ Return exit status }
  922. end;
  923. Function Shell(const Command:AnsiString):Longint;
  924. {
  925. AnsiString version of Shell
  926. }
  927. var
  928. p : ppchar;
  929. temp,pid : longint;
  930. begin
  931. pid:=fork;
  932. if pid=-1 then
  933. exit; {Linuxerror already set in Fork}
  934. if pid=0 then
  935. begin
  936. {This is the child.}
  937. p:=CreateShellArgv(command);
  938. Execve(p^,p,envp);
  939. exit(127);
  940. end;
  941. temp:=0;
  942. WaitPid(pid,@temp,0);{Linuxerror is set there}
  943. Shell:=temp;{ Return exit status }
  944. end;
  945. Function GetPriority(Which,Who:Integer):integer;
  946. {
  947. Get Priority of process, process group, or user.
  948. Which : selects what kind of priority is used.
  949. can be one of the following predefined Constants :
  950. Prio_User.
  951. Prio_PGrp.
  952. Prio_Process.
  953. Who : depending on which, this is , respectively :
  954. Uid
  955. Pid
  956. Process Group id
  957. Errors are reported in linuxerror _only_. (priority can be negative)
  958. }
  959. var
  960. sr : Syscallregs;
  961. begin
  962. errno:=0;
  963. if (which<prio_process) or (which>prio_user) then
  964. begin
  965. { We can save an interrupt here }
  966. getpriority:=0;
  967. linuxerror:=Sys_einval;
  968. end
  969. else
  970. begin
  971. sr.reg2:=which;
  972. sr.reg3:=who;
  973. getpriority:=SysCall(Syscall_nr_getpriority,sr);
  974. linuxerror:=errno;
  975. end;
  976. end;
  977. Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
  978. {
  979. Set Priority of process, process group, or user.
  980. Which : selects what kind of priority is used.
  981. can be one of the following predefined Constants :
  982. Prio_User.
  983. Prio_PGrp.
  984. Prio_Process.
  985. Who : depending on value of which, this is, respectively :
  986. Uid
  987. Pid
  988. Process Group id
  989. what : A number between -20 and 20. -20 is most favorable, 20 least.
  990. 0 is the default.
  991. }
  992. var
  993. sr : Syscallregs;
  994. begin
  995. errno:=0;
  996. if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
  997. linuxerror:=Sys_einval { We can save an interrupt here }
  998. else
  999. begin
  1000. sr.reg2:=which;
  1001. sr.reg3:=who;
  1002. sr.reg4:=what;
  1003. SysCall(Syscall_nr_setpriority,sr);
  1004. linuxerror:=errno;
  1005. end;
  1006. end;
  1007. Procedure Nice(N:integer);
  1008. {
  1009. Set process priority. A positive N means a lower priority.
  1010. A negative N decreases priority.
  1011. }
  1012. var
  1013. sr : Syscallregs;
  1014. begin
  1015. sr.reg2:=n;
  1016. SysCall(Syscall_nr_nice,sr);
  1017. linuxerror:=errno;
  1018. end;
  1019. Function GetPid:LongInt;
  1020. {
  1021. Get Process ID.
  1022. }
  1023. var
  1024. regs : SysCallregs;
  1025. begin
  1026. GetPid:=SysCall(SysCall_nr_getpid,regs);
  1027. linuxerror:=errno;
  1028. end;
  1029. Function GetPPid:LongInt;
  1030. {
  1031. Get Process ID of parent process.
  1032. }
  1033. var
  1034. regs : SysCallregs;
  1035. begin
  1036. GetPpid:=SysCall(SysCall_nr_getppid,regs);
  1037. linuxerror:=errno;
  1038. end;
  1039. Function GetUid:Longint;
  1040. {
  1041. Get User ID.
  1042. }
  1043. var
  1044. regs : SysCallregs;
  1045. begin
  1046. GetUid:=SysCall(SysCall_nr_getuid,regs);
  1047. Linuxerror:=errno;
  1048. end;
  1049. Function GetEUid:Longint;
  1050. {
  1051. Get _effective_ User ID.
  1052. }
  1053. var
  1054. regs : SysCallregs;
  1055. begin
  1056. GetEuid:=SysCall(SysCall_nr_geteuid,regs);
  1057. Linuxerror:=errno;
  1058. end;
  1059. Function GetGid:Longint;
  1060. {
  1061. Get Group ID.
  1062. }
  1063. var
  1064. regs : SysCallregs;
  1065. begin
  1066. Getgid:=SysCall(SysCall_nr_getgid,regs);
  1067. Linuxerror:=errno;
  1068. end;
  1069. Function GetEGid:Longint;
  1070. {
  1071. Get _effective_ Group ID.
  1072. }
  1073. var
  1074. regs : SysCallregs;
  1075. begin
  1076. GetEgid:=SysCall(SysCall_nr_getegid,regs);
  1077. Linuxerror:=errno;
  1078. end;
  1079. {******************************************************************************
  1080. Date and Time related calls
  1081. ******************************************************************************}
  1082. Const
  1083. {Date Translation}
  1084. C1970=2440588;
  1085. D0 = 1461;
  1086. D1 = 146097;
  1087. D2 =1721119;
  1088. Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
  1089. Var
  1090. Century,XYear: LongInt;
  1091. Begin
  1092. If Month<=2 Then
  1093. Begin
  1094. Dec(Year);
  1095. Inc(Month,12);
  1096. End;
  1097. Dec(Month,3);
  1098. Century:=(longint(Year Div 100)*D1) shr 2;
  1099. XYear:=(longint(Year Mod 100)*D0) shr 2;
  1100. GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
  1101. End;
  1102. Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
  1103. Var
  1104. YYear,XYear,Temp,TempMonth : LongInt;
  1105. Begin
  1106. Temp:=((JulianDN-D2) shl 2)-1;
  1107. JulianDN:=Temp Div D1;
  1108. XYear:=(Temp Mod D1) or 3;
  1109. YYear:=(XYear Div D0);
  1110. Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
  1111. Day:=((Temp Mod 153)+5) Div 5;
  1112. TempMonth:=Temp Div 153;
  1113. If TempMonth>=10 Then
  1114. Begin
  1115. inc(YYear);
  1116. dec(TempMonth,12);
  1117. End;
  1118. inc(TempMonth,3);
  1119. Month := TempMonth;
  1120. Year:=YYear+(JulianDN*100);
  1121. end;
  1122. Procedure GetTimeOfDay(var tv:timeval);
  1123. {
  1124. Get the number of seconds since 00:00, January 1 1970, GMT
  1125. the time NOT corrected any way
  1126. }
  1127. var
  1128. regs : SysCallregs;
  1129. begin
  1130. regs.reg2:=longint(@tv);
  1131. regs.reg3:=0;
  1132. SysCall(SysCall_nr_gettimeofday,regs);
  1133. LinuxError:=Errno;
  1134. end;
  1135. Function GetTimeOfDay: longint;
  1136. {
  1137. Get the number of seconds since 00:00, January 1 1970, GMT
  1138. the time NOT corrected any way
  1139. }
  1140. var
  1141. regs : SysCallregs;
  1142. tv : timeval;
  1143. begin
  1144. regs.reg2:=longint(@tv);
  1145. regs.reg3:=0;
  1146. SysCall(SysCall_nr_gettimeofday,regs);
  1147. LinuxError:=Errno;
  1148. GetTimeOfDay:=tv.sec;
  1149. end;
  1150. Function GetEpochTime: longint;
  1151. {
  1152. Get the number of seconds since 00:00, January 1 1970, GMT
  1153. the time NOT corrected any way
  1154. }
  1155. begin
  1156. GetEpochTime:=GetTimeOfDay;
  1157. end;
  1158. Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
  1159. {
  1160. Transforms Epoch time into local time (hour, minute,seconds)
  1161. }
  1162. Var
  1163. DateNum: LongInt;
  1164. Begin
  1165. inc(Epoch,TZSeconds);
  1166. Datenum:=(Epoch Div 86400) + c1970;
  1167. JulianToGregorian(DateNum,Year,Month,day);
  1168. Epoch:=Epoch Mod 86400;
  1169. Hour:=Epoch Div 3600;
  1170. Epoch:=Epoch Mod 3600;
  1171. Minute:=Epoch Div 60;
  1172. Second:=Epoch Mod 60;
  1173. End;
  1174. Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
  1175. {
  1176. Transforms local time (year,month,day,hour,minutes,second) to Epoch time
  1177. (seconds since 00:00, january 1 1970, corrected for local time zone)
  1178. }
  1179. Begin
  1180. LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
  1181. (LongInt(Hour)*3600)+(Minute*60)+Second-TZSeconds;
  1182. End;
  1183. procedure GetTime(var hour,min,sec,msec,usec:word);
  1184. {
  1185. Gets the current time, adjusted to local time
  1186. }
  1187. var
  1188. year,day,month:Word;
  1189. t : timeval;
  1190. begin
  1191. gettimeofday(t);
  1192. EpochToLocal(t.sec,year,month,day,hour,min,sec);
  1193. msec:=t.usec div 1000;
  1194. usec:=t.usec mod 1000;
  1195. end;
  1196. procedure GetTime(var hour,min,sec,sec100:word);
  1197. {
  1198. Gets the current time, adjusted to local time
  1199. }
  1200. var
  1201. usec : word;
  1202. begin
  1203. gettime(hour,min,sec,sec100,usec);
  1204. sec100:=sec100 div 10;
  1205. end;
  1206. Procedure GetTime(Var Hour,Min,Sec:Word);
  1207. {
  1208. Gets the current time, adjusted to local time
  1209. }
  1210. var
  1211. msec,usec : Word;
  1212. Begin
  1213. gettime(hour,min,sec,msec,usec);
  1214. End;
  1215. Procedure GetDate(Var Year,Month,Day:Word);
  1216. {
  1217. Gets the current date, adjusted to local time
  1218. }
  1219. var
  1220. hour,minute,second : word;
  1221. Begin
  1222. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  1223. End;
  1224. Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
  1225. {
  1226. Gets the current date, adjusted to local time
  1227. }
  1228. Begin
  1229. EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
  1230. End;
  1231. { Include timezone handling routines which use /usr/share/timezone info }
  1232. {$i timezone.inc}
  1233. {******************************************************************************
  1234. FileSystem calls
  1235. ******************************************************************************}
  1236. Function fdOpen(pathname:string;flags:longint):longint;
  1237. begin
  1238. pathname:=pathname+#0;
  1239. fdOpen:=Sys_Open(@pathname[1],flags,438);
  1240. LinuxError:=Errno;
  1241. end;
  1242. Function fdOpen(pathname:string;flags,mode:longint):longint;
  1243. begin
  1244. pathname:=pathname+#0;
  1245. fdOpen:=Sys_Open(@pathname[1],flags,mode);
  1246. LinuxError:=Errno;
  1247. end;
  1248. Function fdOpen(pathname:pchar;flags:longint):longint;
  1249. begin
  1250. fdOpen:=Sys_Open(pathname,flags,0);
  1251. LinuxError:=Errno;
  1252. end;
  1253. Function fdOpen(pathname:pchar;flags,mode:longint):longint;
  1254. begin
  1255. fdOpen:=Sys_Open(pathname,flags,mode);
  1256. LinuxError:=Errno;
  1257. end;
  1258. Function fdClose(fd:longint):boolean;
  1259. begin
  1260. fdClose:=(Sys_Close(fd)=0);
  1261. LinuxError:=Errno;
  1262. end;
  1263. Function fdRead(fd:longint;var buf;size:longint):longint;
  1264. begin
  1265. fdRead:=Sys_Read(fd,pchar(@buf),size);
  1266. LinuxError:=Errno;
  1267. end;
  1268. Function fdWrite(fd:longint;var buf;size:longint):longint;
  1269. begin
  1270. fdWrite:=Sys_Write(fd,pchar(@buf),size);
  1271. LinuxError:=Errno;
  1272. end;
  1273. Function fdTruncate(fd,size:longint):boolean;
  1274. var
  1275. Regs : SysCallRegs;
  1276. begin
  1277. Regs.reg2:=fd;
  1278. Regs.reg3:=size;
  1279. fdTruncate:=(SysCall(Syscall_nr_ftruncate,regs)=0);
  1280. LinuxError:=Errno;
  1281. end;
  1282. Function fdSeek (fd,pos,seektype :longint): longint;
  1283. {
  1284. Do a Seek on a file descriptor fd to position pos, starting from seektype
  1285. }
  1286. begin
  1287. fdseek:=Sys_LSeek (fd,pos,seektype);
  1288. LinuxError:=Errno;
  1289. end;
  1290. Function fdFlush (fd : Longint) : Boolean;
  1291. var
  1292. SR: SysCallRegs;
  1293. begin
  1294. SR.reg2 := fd;
  1295. fdFlush := (SysCall(syscall_nr_fsync, SR)=0);
  1296. LinuxError:=Errno;
  1297. end;
  1298. Function Fcntl(Fd:longint;Cmd:integer):integer;
  1299. {
  1300. Read or manipulate a file.(See also fcntl (2) )
  1301. Possible values for Cmd are :
  1302. F_GetFd,F_GetFl,F_GetOwn
  1303. Errors are reported in Linuxerror;
  1304. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  1305. }
  1306. var
  1307. sr : Syscallregs;
  1308. begin
  1309. if (cmd in [F_GetFd,F_GetFl,F_GetOwn]) then
  1310. begin
  1311. sr.reg2:=Fd;
  1312. sr.reg3:=cmd;
  1313. Linuxerror:=SysCall(Syscall_nr_fcntl,sr);
  1314. if linuxerror=-1 then
  1315. begin
  1316. linuxerror:=errno;
  1317. fcntl:=0;
  1318. end
  1319. else
  1320. begin
  1321. fcntl:=linuxerror;
  1322. linuxerror:=0;
  1323. end;
  1324. end
  1325. else
  1326. begin
  1327. linuxerror:=Sys_einval;
  1328. Fcntl:=0;
  1329. end;
  1330. end;
  1331. Procedure Fcntl(Fd:longint;Cmd:Integer;Arg:Longint);
  1332. {
  1333. Read or manipulate a file. (See also fcntl (2) )
  1334. Possible values for Cmd are :
  1335. F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
  1336. Errors are reported in Linuxerror;
  1337. If Cmd is different from the allowed values, linuxerror=Sys_eninval.
  1338. F_DupFD is not allowed, due to the structure of Files in Pascal.
  1339. }
  1340. var
  1341. sr : Syscallregs;
  1342. begin
  1343. if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn]) then
  1344. begin
  1345. sr.reg2:=Fd;
  1346. sr.reg3:=cmd;
  1347. sr.reg4:=arg;
  1348. SysCall(Syscall_nr_fcntl,sr);
  1349. linuxerror:=errno;
  1350. end
  1351. else
  1352. linuxerror:=Sys_einval;
  1353. end;
  1354. Function Fcntl(var Fd:Text;Cmd:integer):integer;
  1355. begin
  1356. Fcntl := Fcntl(textrec(Fd).handle, Cmd);
  1357. end;
  1358. Procedure Fcntl(var Fd:Text;Cmd:Integer;Arg:Longint);
  1359. begin
  1360. Fcntl(textrec(Fd).handle, Cmd, Arg);
  1361. end;
  1362. Function Chmod(path:pathstr;Newmode:longint):Boolean;
  1363. {
  1364. Changes the permissions of a file.
  1365. }
  1366. var
  1367. sr : Syscallregs;
  1368. begin
  1369. path:=path+#0;
  1370. sr.reg2:=longint(@(path[1]));
  1371. sr.reg3:=newmode;
  1372. Chmod:=(SysCall(Syscall_nr_chmod,sr)=0);
  1373. linuxerror:=errno;
  1374. end;
  1375. Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
  1376. {
  1377. Change the owner and group of a file.
  1378. A user can only change the group to a group of which he is a member.
  1379. The super-user can change uid and gid of any file.
  1380. }
  1381. var
  1382. sr : Syscallregs;
  1383. begin
  1384. path:=path+#0;
  1385. sr.reg2:=longint(@(path[1]));
  1386. sr.reg3:=newuid;
  1387. sr.reg4:=newgid;
  1388. ChOwn:=(Syscall(Syscall_nr_chown,sr)=0);
  1389. linuxerror:=errno;
  1390. end;
  1391. Function Utime(path:pathstr;utim:utimebuf):boolean;
  1392. var
  1393. sr : Syscallregs;
  1394. begin
  1395. path:=path+#0;
  1396. sr.reg2:=longint(@(path[1]));
  1397. sr.reg3:=longint(@utim);
  1398. Utime:=SysCall(Syscall_nr_utime,sr)=0;
  1399. linuxerror:=errno;
  1400. end;
  1401. Function Flock (fd,mode : longint) : boolean;
  1402. var
  1403. sr : Syscallregs;
  1404. begin
  1405. sr.reg2:=fd;
  1406. sr.reg3:=mode;
  1407. flock:=Syscall(Syscall_nr_flock,sr)=0;
  1408. LinuxError:=errno;
  1409. end;
  1410. Function Flock (var T : text;mode : longint) : boolean;
  1411. begin
  1412. Flock:=Flock(TextRec(T).Handle,mode);
  1413. end;
  1414. Function Flock (var F : File;mode : longint) : boolean;
  1415. begin
  1416. Flock:=Flock(FileRec(F).Handle,mode);
  1417. end;
  1418. Function FStat(Path:Pathstr;Var Info:stat):Boolean;
  1419. {
  1420. Get all information on a file, and return it in Info.
  1421. }
  1422. begin
  1423. path:=path+#0;
  1424. FStat:=(Sys_stat(@(path[1]),Info)=0);
  1425. LinuxError:=errno;
  1426. end;
  1427. Function Fstat(Fd:Longint;var Info:stat):Boolean;
  1428. {
  1429. Get all information on a file descriptor, and return it in info.
  1430. }
  1431. var
  1432. regs : SysCallregs;
  1433. begin
  1434. regs.reg2:=Fd;
  1435. regs.reg3:=longint(@Info);
  1436. FStat:=(SysCall(SysCall_nr_fstat,regs)=0);
  1437. LinuxError:=Errno;
  1438. end;
  1439. Function FStat(var F:Text;Var Info:stat):Boolean;
  1440. {
  1441. Get all information on a text file, and return it in info.
  1442. }
  1443. begin
  1444. FStat:=Fstat(TextRec(F).Handle,INfo);
  1445. end;
  1446. Function FStat(var F:File;Var Info:stat):Boolean;
  1447. {
  1448. Get all information on a untyped file, and return it in info.
  1449. }
  1450. begin
  1451. FStat:=Fstat(FileRec(F).Handle,Info);
  1452. end;
  1453. Function Lstat(Filename: PathStr;var Info:stat):Boolean;
  1454. {
  1455. Get all information on a link (the link itself), and return it in info.
  1456. }
  1457. var
  1458. regs : SysCallregs;
  1459. begin
  1460. FileName:=FileName+#0;
  1461. regs.reg2:=longint(@filename[1]);
  1462. regs.reg3:=longint(@Info);
  1463. LStat:=(SysCall(SysCall_nr_lstat,regs)=0);
  1464. LinuxError:=Errno;
  1465. end;
  1466. Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
  1467. {
  1468. Get all information on a fileSystem, and return it in Info.
  1469. Path is the name of a file/directory on the fileSystem you wish to
  1470. investigate.
  1471. }
  1472. var
  1473. regs : SysCallregs;
  1474. begin
  1475. path:=path+#0;
  1476. regs.reg2:=longint(@path[1]);
  1477. regs.reg3:=longint(@Info);
  1478. FSStat:=(SysCall(SysCall_nr_statfs,regs)=0);
  1479. LinuxError:=errno;
  1480. end;
  1481. Function FSStat(Fd:Longint;Var Info:statfs):Boolean;
  1482. {
  1483. Get all information on a fileSystem, and return it in Info.
  1484. Fd is the file descriptor of a file/directory on the fileSystem
  1485. you wish to investigate.
  1486. }
  1487. var
  1488. regs : SysCallregs;
  1489. begin
  1490. regs.reg2:=Fd;
  1491. regs.reg3:=longint(@Info);
  1492. FSStat:=(SysCall(SysCall_nr_fstatfs,regs)=0);
  1493. LinuxError:=errno;
  1494. end;
  1495. Function Link(OldPath,NewPath:pathstr):boolean;
  1496. {
  1497. Proceduces a hard link from new to old.
  1498. In effect, new will be the same file as old.
  1499. }
  1500. var
  1501. regs : SysCallregs;
  1502. begin
  1503. oldpath:=oldpath+#0;
  1504. newpath:=newpath+#0;
  1505. regs.reg2:=longint(@oldpath[1]);
  1506. regs.reg3:=longint(@newpath[1]);
  1507. Link:=SysCall(SysCall_nr_link,regs)=0;
  1508. linuxerror:=errno;
  1509. end;
  1510. Function SymLink(OldPath,newPath:pathstr):boolean;
  1511. {
  1512. Proceduces a soft link from new to old.
  1513. }
  1514. begin
  1515. oldpath:=oldpath+#0;
  1516. newpath:=newpath+#0;
  1517. Symlink:=Sys_symlink(pchar(@(oldpath[1])),pchar(@(newpath[1])))=0;
  1518. linuxerror:=errno;
  1519. end;
  1520. Function ReadLink(name,linkname:pchar;maxlen:longint):longint;
  1521. {
  1522. Read a link (where it points to)
  1523. }
  1524. begin
  1525. Readlink:=Sys_readlink(Name,LinkName,maxlen);
  1526. linuxerror:=errno;
  1527. end;
  1528. Function ReadLink(Name:pathstr):pathstr;
  1529. {
  1530. Read a link (where it points to)
  1531. }
  1532. var
  1533. LinkName : pathstr;
  1534. i : longint;
  1535. begin
  1536. Name:=Name+#0;
  1537. i:=ReadLink(@Name[1],@LinkName[1],high(linkname));
  1538. if i>0 then
  1539. begin
  1540. linkname[0]:=chr(i);
  1541. ReadLink:=LinkName;
  1542. end
  1543. else
  1544. ReadLink:='';
  1545. end;
  1546. Function UnLink(Path:pathstr):boolean;
  1547. {
  1548. Removes the file in 'Path' (that is, it decreases the link count with one.
  1549. if the link count is zero, the file is removed from the disk.
  1550. }
  1551. begin
  1552. path:=path+#0;
  1553. Unlink:=Sys_unlink(pchar(@(path[1])))=0;
  1554. linuxerror:=errno;
  1555. end;
  1556. Function UnLink(Path:pchar):Boolean;
  1557. {
  1558. Removes the file in 'Path' (that is, it decreases the link count with one.
  1559. if the link count is zero, the file is removed from the disk.
  1560. }
  1561. begin
  1562. Unlink:=(Sys_unlink(path)=0);
  1563. linuxerror:=errno;
  1564. end;
  1565. Function FRename (OldName,NewName : Pchar) : Boolean;
  1566. begin
  1567. FRename:=Sys_rename(OldName,NewName)=0;
  1568. LinuxError:=Errno;
  1569. end;
  1570. Function FRename (OldName,NewName : String) : Boolean;
  1571. begin
  1572. OldName:=OldName+#0;
  1573. NewName:=NewName+#0;
  1574. FRename:=FRename (@OldName[1],@NewName[1]);
  1575. end;
  1576. Function Umask(Mask:Integer):integer;
  1577. {
  1578. Sets file creation mask to (Mask and 0777 (octal) ), and returns the
  1579. previous value.
  1580. }
  1581. var
  1582. sr : Syscallregs;
  1583. begin
  1584. sr.reg2:=mask;
  1585. Umask:=SysCall(Syscall_nr_umask,sr);
  1586. linuxerror:=0;
  1587. end;
  1588. Function Access(Path:Pathstr ;mode:integer):boolean;
  1589. {
  1590. Test users access rights on the specified file.
  1591. Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
  1592. R,W,X stand for read,write and Execute access, simultaneously.
  1593. F_OK checks whether the test would be allowed on the file.
  1594. i.e. It checks the search permissions in all directory components
  1595. of the path.
  1596. The test is done with the real user-ID, instead of the effective.
  1597. If access is denied, or an error occurred, false is returned.
  1598. If access is granted, true is returned.
  1599. Errors other than no access,are reported in linuxerror.
  1600. }
  1601. var
  1602. sr : Syscallregs;
  1603. begin
  1604. path:=path+#0;
  1605. sr.reg2:=longint(@(path[1]));
  1606. sr.reg3:=mode;
  1607. access:=(SysCall(Syscall_nr_access,sr)=0);
  1608. linuxerror:=errno;
  1609. end;
  1610. Function Dup(oldfile:longint;var newfile:longint):Boolean;
  1611. {
  1612. Copies the filedescriptor oldfile to newfile
  1613. }
  1614. var
  1615. sr : Syscallregs;
  1616. begin
  1617. sr.reg2:=oldfile;
  1618. newfile:=Syscall(Syscall_nr_dup,sr);
  1619. linuxerror:=errno;
  1620. Dup:=(LinuxError=0);
  1621. end;
  1622. Function Dup(var oldfile,newfile:text):Boolean;
  1623. {
  1624. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  1625. oldfile.
  1626. After which the two textfiles are, in effect, the same, except
  1627. that they don't share the same buffer, and don't share the same
  1628. close_on_exit flag.
  1629. }
  1630. begin
  1631. flush(oldfile);{ We cannot share buffers, so we flush them. }
  1632. textrec(newfile):=textrec(oldfile);
  1633. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  1634. Dup:=Dup(textrec(oldfile).handle,textrec(newfile).handle);
  1635. end;
  1636. Function Dup(var oldfile,newfile:file):Boolean;
  1637. {
  1638. Copies the filedescriptor oldfile to newfile
  1639. }
  1640. begin
  1641. filerec(newfile):=filerec(oldfile);
  1642. Dup:=Dup(filerec(oldfile).handle,filerec(newfile).handle);
  1643. end;
  1644. Function Dup2(oldfile,newfile:longint):Boolean;
  1645. {
  1646. Copies the filedescriptor oldfile to newfile
  1647. }
  1648. var
  1649. sr : Syscallregs;
  1650. begin
  1651. sr.reg2:=oldfile;
  1652. sr.reg3:=newfile;
  1653. SysCall(Syscall_nr_dup2,sr);
  1654. linuxerror:=errno;
  1655. Dup2:=(LinuxError=0);
  1656. end;
  1657. Function Dup2(var oldfile,newfile:text):Boolean;
  1658. {
  1659. Copies the filedescriptor oldfile to newfile, after flushing the buffer of
  1660. oldfile. It closes newfile if it was still open.
  1661. After which the two textfiles are, in effect, the same, except
  1662. that they don't share the same buffer, and don't share the same
  1663. close_on_exit flag.
  1664. }
  1665. var
  1666. tmphandle : word;
  1667. begin
  1668. case TextRec(oldfile).mode of
  1669. fmOutput, fmInOut, fmAppend :
  1670. flush(oldfile);{ We cannot share buffers, so we flush them. }
  1671. end;
  1672. case TextRec(newfile).mode of
  1673. fmOutput, fmInOut, fmAppend :
  1674. flush(newfile);
  1675. end;
  1676. tmphandle:=textrec(newfile).handle;
  1677. textrec(newfile):=textrec(oldfile);
  1678. textrec(newfile).handle:=tmphandle;
  1679. textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
  1680. Dup2:=Dup2(textrec(oldfile).handle,textrec(newfile).handle);
  1681. end;
  1682. Function Dup2(var oldfile,newfile:file):Boolean;
  1683. {
  1684. Copies the filedescriptor oldfile to newfile
  1685. }
  1686. begin
  1687. filerec(newfile):=filerec(oldfile);
  1688. Dup2:=Dup2(filerec(oldfile).handle,filerec(newfile).handle);
  1689. end;
  1690. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
  1691. {
  1692. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  1693. have changed.
  1694. }
  1695. Var
  1696. SelectArray : Array[1..5] of longint;
  1697. Sr : Syscallregs;
  1698. begin
  1699. SelectArray[1]:=n;
  1700. SelectArray[2]:=longint(Readfds);
  1701. Selectarray[3]:=longint(Writefds);
  1702. selectarray[4]:=longint(exceptfds);
  1703. Selectarray[5]:=longint(TimeOut);
  1704. sr.reg2:=longint(@selectarray);
  1705. Select:=SysCall(Syscall_nr_select,sr);
  1706. LinuxError:=Errno;
  1707. end;
  1708. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  1709. {
  1710. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  1711. have changed.
  1712. This function allows specification of a timeout as a longint.
  1713. }
  1714. var
  1715. p : PTimeVal;
  1716. tv : TimeVal;
  1717. begin
  1718. if TimeOut=-1 then
  1719. p:=nil
  1720. else
  1721. begin
  1722. tv.Sec:=Timeout div 1000;
  1723. tv.Usec:=(Timeout mod 1000)*1000;
  1724. p:=@tv;
  1725. end;
  1726. Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
  1727. end;
  1728. Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
  1729. Var
  1730. F:FDSet;
  1731. begin
  1732. if textrec(t).mode=fmclosed then
  1733. begin
  1734. LinuxError:=Sys_EBADF;
  1735. exit(-1);
  1736. end;
  1737. FD_Zero(f);
  1738. FD_Set(textrec(T).handle,f);
  1739. if textrec(T).mode=fminput then
  1740. SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
  1741. else
  1742. SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
  1743. end;
  1744. {******************************************************************************
  1745. Directory
  1746. ******************************************************************************}
  1747. Function OpenDir(F:String):PDir;
  1748. begin
  1749. F:=F+#0;
  1750. OpenDir:=OpenDir(@F[1]);
  1751. end;
  1752. procedure SeekDir(p:pdir;off:longint);
  1753. begin
  1754. if p=nil then
  1755. begin
  1756. errno:=Sys_EBADF;
  1757. exit;
  1758. end;
  1759. p^.nextoff:=Sys_lseek(p^.fd,off,seek_set);
  1760. p^.size:=0;
  1761. p^.loc:=0;
  1762. end;
  1763. function TellDir(p:pdir):longint;
  1764. begin
  1765. if p=nil then
  1766. begin
  1767. errno:=Sys_EBADF;
  1768. telldir:=-1;
  1769. exit;
  1770. end;
  1771. telldir:=Sys_lseek(p^.fd,0,seek_cur)
  1772. { We could try to use the nextoff field here, but on my 1.2.13
  1773. kernel, this gives nothing... This may have to do with
  1774. the readdir implementation of libc... I also didn't find any trace of
  1775. the field in the kernel code itself, So I suspect it is an artifact of libc.
  1776. Michael. }
  1777. end;
  1778. Function ReadDir(P:pdir):pdirent;
  1779. begin
  1780. ReadDir:=Sys_ReadDir(p);
  1781. LinuxError:=Errno;
  1782. end;
  1783. {******************************************************************************
  1784. Pipes/Fifo
  1785. ******************************************************************************}
  1786. Procedure OpenPipe(var F:Text);
  1787. begin
  1788. case textrec(f).mode of
  1789. fmoutput :
  1790. if textrec(f).userdata[1]<>P_OUT then
  1791. textrec(f).mode:=fmclosed;
  1792. fminput :
  1793. if textrec(f).userdata[1]<>P_IN then
  1794. textrec(f).mode:=fmclosed;
  1795. else
  1796. textrec(f).mode:=fmclosed;
  1797. end;
  1798. end;
  1799. Procedure IOPipe(var F:text);
  1800. begin
  1801. case textrec(f).mode of
  1802. fmoutput :
  1803. begin
  1804. { first check if we need something to write, else we may
  1805. get a SigPipe when Close() is called (PFV) }
  1806. if textrec(f).bufpos>0 then
  1807. Sys_write(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
  1808. end;
  1809. fminput :
  1810. textrec(f).bufend:=Sys_read(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
  1811. end;
  1812. textrec(f).bufpos:=0;
  1813. end;
  1814. Procedure FlushPipe(var F:Text);
  1815. begin
  1816. if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
  1817. IOPipe(f);
  1818. textrec(f).bufpos:=0;
  1819. end;
  1820. Procedure ClosePipe(var F:text);
  1821. begin
  1822. textrec(f).mode:=fmclosed;
  1823. Sys_close(textrec(f).handle);
  1824. end;
  1825. Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
  1826. {
  1827. Sets up a pair of file variables, which act as a pipe. The first one can
  1828. be read from, the second one can be written to.
  1829. If the operation was unsuccesful, linuxerror is set.
  1830. }
  1831. var
  1832. pip : tpipe;
  1833. regs : SysCallregs;
  1834. begin
  1835. regs.reg2:=longint(@pip);
  1836. SysCall(SysCall_nr_pipe,regs);
  1837. pipe_in:=pip[1];
  1838. pipe_out:=pip[2];
  1839. linuxerror:=errno;
  1840. AssignPipe:=(LinuxError=0);
  1841. end;
  1842. Function AssignPipe(var pipe_in,pipe_out:text):boolean;
  1843. {
  1844. Sets up a pair of file variables, which act as a pipe. The first one can
  1845. be read from, the second one can be written to.
  1846. If the operation was unsuccesful, linuxerror is set.
  1847. }
  1848. var
  1849. f_in,f_out : longint;
  1850. begin
  1851. if not AssignPipe(f_in,f_out) then
  1852. begin
  1853. AssignPipe:=false;
  1854. exit;
  1855. end;
  1856. { Set up input }
  1857. Assign(Pipe_in,'');
  1858. Textrec(Pipe_in).Handle:=f_in;
  1859. Textrec(Pipe_in).Mode:=fmInput;
  1860. Textrec(Pipe_in).userdata[1]:=P_IN;
  1861. TextRec(Pipe_in).OpenFunc:=@OpenPipe;
  1862. TextRec(Pipe_in).InOutFunc:=@IOPipe;
  1863. TextRec(Pipe_in).FlushFunc:=@FlushPipe;
  1864. TextRec(Pipe_in).CloseFunc:=@ClosePipe;
  1865. { Set up output }
  1866. Assign(Pipe_out,'');
  1867. Textrec(Pipe_out).Handle:=f_out;
  1868. Textrec(Pipe_out).Mode:=fmOutput;
  1869. Textrec(Pipe_out).userdata[1]:=P_OUT;
  1870. TextRec(Pipe_out).OpenFunc:=@OpenPipe;
  1871. TextRec(Pipe_out).InOutFunc:=@IOPipe;
  1872. TextRec(Pipe_out).FlushFunc:=@FlushPipe;
  1873. TextRec(Pipe_out).CloseFunc:=@ClosePipe;
  1874. AssignPipe:=true;
  1875. end;
  1876. Function AssignPipe(var pipe_in,pipe_out:file):boolean;
  1877. {
  1878. Sets up a pair of file variables, which act as a pipe. The first one can
  1879. be read from, the second one can be written to.
  1880. If the operation was unsuccesful, linuxerror is set.
  1881. }
  1882. var
  1883. f_in,f_out : longint;
  1884. begin
  1885. if not AssignPipe(f_in,f_out) then
  1886. begin
  1887. AssignPipe:=false;
  1888. exit;
  1889. end;
  1890. { Set up input }
  1891. Assign(Pipe_in,'');
  1892. Filerec(Pipe_in).Handle:=f_in;
  1893. Filerec(Pipe_in).Mode:=fmInput;
  1894. Filerec(Pipe_in).recsize:=1;
  1895. Filerec(Pipe_in).userdata[1]:=P_IN;
  1896. { Set up output }
  1897. Assign(Pipe_out,'');
  1898. Filerec(Pipe_out).Handle:=f_out;
  1899. Filerec(Pipe_out).Mode:=fmoutput;
  1900. Filerec(Pipe_out).recsize:=1;
  1901. Filerec(Pipe_out).userdata[1]:=P_OUT;
  1902. AssignPipe:=true;
  1903. end;
  1904. Function PClose(Var F:text) :longint;
  1905. var
  1906. sr : syscallregs;
  1907. pl : ^longint;
  1908. res : longint;
  1909. begin
  1910. sr.reg2:=Textrec(F).Handle;
  1911. SysCall (syscall_nr_close,sr);
  1912. { closed our side, Now wait for the other - this appears to be needed ?? }
  1913. pl:=@(textrec(f).userdata[2]);
  1914. waitpid(pl^,@res,0);
  1915. pclose:=res shr 8;
  1916. end;
  1917. Function PClose(Var F:file) : longint;
  1918. var
  1919. sr : syscallregs;
  1920. pl : ^longint;
  1921. res : longint;
  1922. begin
  1923. sr.reg2:=FileRec(F).Handle;
  1924. SysCall (Syscall_nr_close,sr);
  1925. { closed our side, Now wait for the other - this appears to be needed ?? }
  1926. pl:=@(filerec(f).userdata[2]);
  1927. waitpid(pl^,@res,0);
  1928. pclose:=res shr 8;
  1929. end;
  1930. Procedure PCloseText(Var F:text);
  1931. {
  1932. May not use @PClose due overloading
  1933. }
  1934. begin
  1935. PClose(f);
  1936. end;
  1937. Procedure POpen(var F:text;const Prog:String;rw:char);
  1938. {
  1939. Starts the program in 'Prog' and makes it's input or out put the
  1940. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  1941. F, will be read from stdin by the program in 'Prog'. The inverse is true
  1942. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  1943. read from 'f'.
  1944. }
  1945. var
  1946. pipi,
  1947. pipo : text;
  1948. pid : longint;
  1949. pl : ^longint;
  1950. pp : ppchar;
  1951. begin
  1952. LinuxError:=0;
  1953. rw:=upcase(rw);
  1954. if not (rw in ['R','W']) then
  1955. begin
  1956. LinuxError:=Sys_enoent;
  1957. exit;
  1958. end;
  1959. AssignPipe(pipi,pipo);
  1960. if Linuxerror<>0 then
  1961. exit;
  1962. pid:=fork;
  1963. if linuxerror<>0 then
  1964. begin
  1965. close(pipi);
  1966. close(pipo);
  1967. exit;
  1968. end;
  1969. if pid=0 then
  1970. begin
  1971. { We're in the child }
  1972. if rw='W' then
  1973. begin
  1974. close(pipo);
  1975. dup2(pipi,input);
  1976. close(pipi);
  1977. if linuxerror<>0 then
  1978. halt(127);
  1979. end
  1980. else
  1981. begin
  1982. close(pipi);
  1983. dup2(pipo,output);
  1984. close(pipo);
  1985. if linuxerror<>0 then
  1986. halt(127);
  1987. end;
  1988. pp:=createshellargv(prog);
  1989. Execve(pp^,pp,envp);
  1990. halt(127);
  1991. end
  1992. else
  1993. begin
  1994. { We're in the parent }
  1995. if rw='W' then
  1996. begin
  1997. close(pipi);
  1998. f:=pipo;
  1999. textrec(f).bufptr:=@textrec(f).buffer;
  2000. end
  2001. else
  2002. begin
  2003. close(pipo);
  2004. f:=pipi;
  2005. textrec(f).bufptr:=@textrec(f).buffer;
  2006. end;
  2007. {Save the process ID - needed when closing }
  2008. pl:=@(textrec(f).userdata[2]);
  2009. pl^:=pid;
  2010. textrec(f).closefunc:=@PCloseText;
  2011. end;
  2012. end;
  2013. Procedure POpen(var F:file;const Prog:String;rw:char);
  2014. {
  2015. Starts the program in 'Prog' and makes it's input or out put the
  2016. other end of a pipe. If rw is 'w' or 'W', then whatever is written to
  2017. F, will be read from stdin by the program in 'Prog'. The inverse is true
  2018. for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
  2019. read from 'f'.
  2020. }
  2021. var
  2022. pipi,
  2023. pipo : file;
  2024. pid : longint;
  2025. pl : ^longint;
  2026. p,pp : ppchar;
  2027. temp : string[255];
  2028. begin
  2029. LinuxError:=0;
  2030. rw:=upcase(rw);
  2031. if not (rw in ['R','W']) then
  2032. begin
  2033. LinuxError:=Sys_enoent;
  2034. exit;
  2035. end;
  2036. AssignPipe(pipi,pipo);
  2037. if Linuxerror<>0 then
  2038. exit;
  2039. pid:=fork;
  2040. if linuxerror<>0 then
  2041. begin
  2042. close(pipi);
  2043. close(pipo);
  2044. exit;
  2045. end;
  2046. if pid=0 then
  2047. begin
  2048. { We're in the child }
  2049. if rw='W' then
  2050. begin
  2051. close(pipo);
  2052. dup2(filerec(pipi).handle,stdinputhandle);
  2053. close(pipi);
  2054. if linuxerror<>0 then
  2055. halt(127);
  2056. end
  2057. else
  2058. begin
  2059. close(pipi);
  2060. dup2(filerec(pipo).handle,stdoutputhandle);
  2061. close(pipo);
  2062. if linuxerror<>0 then
  2063. halt(127);
  2064. end;
  2065. getmem(pp,sizeof(pchar)*4);
  2066. temp:='/bin/sh'#0'-c'#0+prog+#0;
  2067. p:=pp;
  2068. p^:=@temp[1];
  2069. inc(p);
  2070. p^:=@temp[9];
  2071. inc(p);
  2072. p^:=@temp[12];
  2073. inc(p);
  2074. p^:=Nil;
  2075. Execve('/bin/sh',pp,envp);
  2076. halt(127);
  2077. end
  2078. else
  2079. begin
  2080. { We're in the parent }
  2081. if rw='W' then
  2082. begin
  2083. close(pipi);
  2084. f:=pipo;
  2085. end
  2086. else
  2087. begin
  2088. close(pipo);
  2089. f:=pipi;
  2090. end;
  2091. {Save the process ID - needed when closing }
  2092. pl:=@(filerec(f).userdata[2]);
  2093. pl^:=pid;
  2094. end;
  2095. end;
  2096. Function mkFifo(pathname:string;mode:longint):boolean;
  2097. var
  2098. regs : SysCallRegs;
  2099. begin
  2100. pathname:=pathname+#0;
  2101. regs.reg2:=longint(@pathname[1]);
  2102. regs.reg3:=mode or STAT_IFIFO;
  2103. regs.reg4:=0;
  2104. mkFifo:=(SysCall(syscall_nr_mknod,regs)=0);
  2105. end;
  2106. Procedure AssignStream(Var StreamIn,Streamout:text;Const Prog:String);
  2107. {
  2108. Starts the program in 'Prog' and makes its input and output the
  2109. other end of two pipes, which are the stdin and stdout of a program
  2110. specified in 'Prog'.
  2111. streamout can be used to write to the program, streamin can be used to read
  2112. the output of the program. See the following diagram :
  2113. Parent Child
  2114. STreamout --> Input
  2115. Streamin <-- Output
  2116. }
  2117. var
  2118. pipi,
  2119. pipo : text;
  2120. pid : longint;
  2121. pl : ^Longint;
  2122. begin
  2123. LinuxError:=0;
  2124. AssignPipe(streamin,pipo);
  2125. if Linuxerror<>0 then
  2126. exit;
  2127. AssignPipe(pipi,streamout);
  2128. if Linuxerror<>0 then
  2129. exit;
  2130. pid:=fork;
  2131. if linuxerror<>0 then
  2132. begin
  2133. close(pipi);
  2134. close(pipo);
  2135. close (streamin);
  2136. close (streamout);
  2137. exit;
  2138. end;
  2139. if pid=0 then
  2140. begin
  2141. { We're in the child }
  2142. { Close what we don't need }
  2143. close(streamout);
  2144. close(streamin);
  2145. dup2(pipi,input);
  2146. if linuxerror<>0 then
  2147. halt(127);
  2148. close(pipi);
  2149. dup2(pipo,output);
  2150. if linuxerror<>0 then
  2151. halt (127);
  2152. close(pipo);
  2153. Execl(Prog);
  2154. halt(127);
  2155. end
  2156. else
  2157. begin
  2158. { we're in the parent}
  2159. close(pipo);
  2160. close(pipi);
  2161. {Save the process ID - needed when closing }
  2162. pl:=@(textrec(StreamIn).userdata[2]);
  2163. pl^:=pid;
  2164. textrec(StreamIn).closefunc:=@PCloseText;
  2165. {Save the process ID - needed when closing }
  2166. pl:=@(textrec(StreamOut).userdata[2]);
  2167. pl^:=pid;
  2168. textrec(StreamOut).closefunc:=@PCloseText;
  2169. end;
  2170. end;
  2171. function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
  2172. {
  2173. Starts the program in 'prog' and makes its input, output and error output the
  2174. other end of three pipes, which are the stdin, stdout and stderr of a program
  2175. specified in 'prog'.
  2176. StreamOut can be used to write to the program, StreamIn can be used to read
  2177. the output of the program, StreamErr reads the error output of the program.
  2178. See the following diagram :
  2179. Parent Child
  2180. StreamOut --> StdIn (input)
  2181. StreamIn <-- StdOut (output)
  2182. StreamErr <-- StdErr (error output)
  2183. }
  2184. var
  2185. PipeIn, PipeOut, PipeErr: text;
  2186. pid: LongInt;
  2187. pl: ^LongInt;
  2188. begin
  2189. LinuxError := 0;
  2190. AssignStream := -1;
  2191. // Assign pipes
  2192. AssignPipe(StreamIn, PipeOut);
  2193. if LinuxError <> 0 then exit;
  2194. AssignPipe(StreamErr, PipeErr);
  2195. if LinuxError <> 0 then begin
  2196. Close(StreamIn);
  2197. Close(PipeOut);
  2198. exit;
  2199. end;
  2200. AssignPipe(PipeIn, StreamOut);
  2201. if LinuxError <> 0 then begin
  2202. Close(StreamIn);
  2203. Close(PipeOut);
  2204. Close(StreamErr);
  2205. Close(PipeErr);
  2206. exit;
  2207. end;
  2208. // Fork
  2209. pid := Fork;
  2210. if LinuxError <> 0 then begin
  2211. Close(StreamIn);
  2212. Close(PipeOut);
  2213. Close(StreamErr);
  2214. Close(PipeErr);
  2215. Close(PipeIn);
  2216. Close(StreamOut);
  2217. exit;
  2218. end;
  2219. if pid = 0 then begin
  2220. // *** We are in the child ***
  2221. // Close what we don not need
  2222. Close(StreamOut);
  2223. Close(StreamIn);
  2224. Close(StreamErr);
  2225. // Connect pipes
  2226. dup2(PipeIn, Input);
  2227. if LinuxError <> 0 then Halt(127);
  2228. Close(PipeIn);
  2229. dup2(PipeOut, Output);
  2230. if LinuxError <> 0 then Halt(127);
  2231. Close(PipeOut);
  2232. dup2(PipeErr, StdErr);
  2233. if LinuxError <> 0 then Halt(127);
  2234. Close(PipeErr);
  2235. // Execute program
  2236. Execl(Prog);
  2237. Halt(127);
  2238. end else begin
  2239. // *** We are in the parent ***
  2240. Close(PipeErr);
  2241. Close(PipeOut);
  2242. Close(PipeIn);
  2243. // Save the process ID - needed when closing
  2244. pl := @(TextRec(StreamIn).userdata[2]);
  2245. pl^ := pid;
  2246. TextRec(StreamIn).closefunc := @PCloseText;
  2247. // Save the process ID - needed when closing
  2248. pl := @(TextRec(StreamOut).userdata[2]);
  2249. pl^ := pid;
  2250. TextRec(StreamOut).closefunc := @PCloseText;
  2251. // Save the process ID - needed when closing
  2252. pl := @(TextRec(StreamErr).userdata[2]);
  2253. pl^ := pid;
  2254. TextRec(StreamErr).closefunc := @PCloseText;
  2255. AssignStream := pid;
  2256. end;
  2257. end;
  2258. {******************************************************************************
  2259. General information calls
  2260. ******************************************************************************}
  2261. Function Sysinfo(var Info:TSysinfo):Boolean;
  2262. {
  2263. Get system info
  2264. }
  2265. var
  2266. regs : SysCallregs;
  2267. Begin
  2268. regs.reg2:=longint(@info);
  2269. Sysinfo:=SysCall(SysCall_nr_Sysinfo,regs)=0;
  2270. End;
  2271. Function Uname(var unamerec:utsname):Boolean;
  2272. {
  2273. Get machine's names
  2274. }
  2275. var
  2276. regs : SysCallregs;
  2277. Begin
  2278. regs.reg2:=longint(@unamerec);
  2279. Uname:=SysCall(SysCall_nr_uname,regs)=0;
  2280. LinuxError:=Errno;
  2281. End;
  2282. Function GetEnv(P:string):Pchar;
  2283. {
  2284. Searches the environment for a string with name p and
  2285. returns a pchar to it's value.
  2286. A pchar is used to accomodate for strings of length > 255
  2287. }
  2288. var
  2289. ep : ppchar;
  2290. found : boolean;
  2291. Begin
  2292. p:=p+'='; {Else HOST will also find HOSTNAME, etc}
  2293. ep:=envp;
  2294. found:=false;
  2295. if ep<>nil then
  2296. begin
  2297. while (not found) and (ep^<>nil) do
  2298. begin
  2299. if strlcomp(@p[1],(ep^),length(p))=0 then
  2300. found:=true
  2301. else
  2302. inc(ep);
  2303. end;
  2304. end;
  2305. if found then
  2306. getenv:=ep^+length(p)
  2307. else
  2308. getenv:=nil;
  2309. end;
  2310. Function GetDomainName:String;
  2311. {
  2312. Get machines domain name. Returns empty string if not set.
  2313. }
  2314. Var
  2315. Sysn : utsname;
  2316. begin
  2317. Uname(Sysn);
  2318. linuxerror:=errno;
  2319. If linuxerror<>0 then
  2320. getdomainname:=''
  2321. else
  2322. getdomainname:=strpas(@Sysn.domainname[0]);
  2323. end;
  2324. Function GetHostName:String;
  2325. {
  2326. Get machines name. Returns empty string if not set.
  2327. }
  2328. Var
  2329. Sysn : utsname;
  2330. begin
  2331. uname(Sysn);
  2332. linuxerror:=errno;
  2333. If linuxerror<>0 then
  2334. gethostname:=''
  2335. else
  2336. gethostname:=strpas(@Sysn.nodename[0]);
  2337. end;
  2338. {******************************************************************************
  2339. Signal handling calls
  2340. ******************************************************************************}
  2341. Function Kill(Pid:longint;Sig:integer):integer;
  2342. {
  2343. Send signal 'sig' to a process, or a group of processes.
  2344. If Pid > 0 then the signal is sent to pid
  2345. pid=-1 to all processes except process 1
  2346. pid < -1 to process group -pid
  2347. Return value is zero, except for case three, where the return value
  2348. is the number of processes to which the signal was sent.
  2349. }
  2350. var
  2351. regs : Syscallregs;
  2352. begin
  2353. regs.reg2:=Pid;
  2354. regs.reg3:=Sig;
  2355. kill:=SysCall(Syscall_nr_kill,regs);
  2356. if kill<0 then
  2357. Kill:=0;
  2358. linuxerror:=errno;
  2359. end;
  2360. Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
  2361. {
  2362. Change action of process upon receipt of a signal.
  2363. Signum specifies the signal (all except SigKill and SigStop).
  2364. If Act is non-nil, it is used to specify the new action.
  2365. If OldAct is non-nil the previous action is saved there.
  2366. }
  2367. Var
  2368. sr : Syscallregs;
  2369. begin
  2370. sr.reg2:=Signum;
  2371. sr.reg3:=Longint(act);
  2372. sr.reg4:=Longint(oldact);
  2373. SysCall(Syscall_nr_sigaction,sr);
  2374. linuxerror:=errno;
  2375. end;
  2376. Procedure SigProcMask(How:Integer;SSet,OldSSet:PSigSet);
  2377. {
  2378. Change the list of currently blocked signals.
  2379. How determines which signals will be blocked :
  2380. SigBlock : Add SSet to the current list of blocked signals
  2381. SigUnBlock : Remove the signals in SSet from the list of blocked signals.
  2382. SigSetMask : Set the list of blocked signals to SSet
  2383. if OldSSet is non-null, the old set will be saved there.
  2384. }
  2385. Var
  2386. sr : SyscallRegs;
  2387. begin
  2388. sr.reg2:=how;
  2389. sr.reg3:=longint(SSet);
  2390. sr.reg4:=longint(OldSSet);
  2391. SysCall(Syscall_nr_sigprocmask,sr);
  2392. linuxerror:=errno;
  2393. end;
  2394. Function SigPending:SigSet;
  2395. {
  2396. Allows examination of pending signals. The signal mask of pending
  2397. signals is set in SSet
  2398. }
  2399. Var
  2400. sr : SyscallRegs;
  2401. dummy : Sigset;
  2402. begin
  2403. sr.reg2:=longint(@dummy);
  2404. SysCall(Syscall_nr_sigpending,sr);
  2405. linuxerror:=errno;
  2406. Sigpending:=dummy;
  2407. end;
  2408. Procedure SigSuspend(Mask:Sigset);
  2409. {
  2410. Set the signal mask with Mask, and suspend the program until a signal
  2411. is received.
  2412. }
  2413. Var
  2414. sr : SyscallRegs;
  2415. begin
  2416. sr.reg2:=mask;
  2417. SysCall(Syscall_nr_sigsuspend,sr);
  2418. linuxerror:=errno;
  2419. end;
  2420. Function Signal(Signum:Integer;Handler:SignalHandler):SignalHandler;
  2421. {
  2422. Install a new handler for signal Signum.
  2423. The old signal handler is returned.
  2424. This call does, in fact, the same as SigAction.
  2425. }
  2426. var
  2427. sr : Syscallregs;
  2428. begin
  2429. sr.reg2:=signum;
  2430. sr.reg3:=longint(handler);
  2431. Linuxerror:=SysCall(Syscall_nr_signal,sr);
  2432. If linuxerror=Sig_Err then
  2433. begin
  2434. Signal:=nil;
  2435. Linuxerror:=errno;
  2436. end
  2437. else
  2438. begin
  2439. Signal:=signalhandler(Linuxerror);
  2440. linuxerror:=0;
  2441. end;
  2442. end;
  2443. procedure SigRaise(sig:integer);
  2444. begin
  2445. Kill(GetPid,Sig);
  2446. end;
  2447. Function Alarm(Sec : Longint) : longint;
  2448. Var Sr : Syscallregs;
  2449. begin
  2450. sr.reg2:=Sec;
  2451. Alarm:=Syscall(syscall_nr_alarm,sr);
  2452. end;
  2453. Procedure Pause;
  2454. Var Sr : Syscallregs;
  2455. begin
  2456. syscall(syscall_nr_pause,sr);
  2457. end;
  2458. {******************************************************************************
  2459. IOCtl and Termios calls
  2460. ******************************************************************************}
  2461. Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
  2462. {
  2463. Interface to Unix ioctl call.
  2464. Performs various operations on the filedescriptor Handle.
  2465. Ndx describes the operation to perform.
  2466. Data points to data needed for the Ndx function. The structure of this
  2467. data is function-dependent.
  2468. }
  2469. var
  2470. sr: SysCallRegs;
  2471. begin
  2472. sr.reg2:=Handle;
  2473. sr.reg3:=Ndx;
  2474. sr.reg4:=Longint(Data);
  2475. IOCtl:=(SysCall(Syscall_nr_ioctl,sr)=0);
  2476. LinuxError:=Errno;
  2477. end;
  2478. Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
  2479. begin
  2480. TCGetAttr:=IOCtl(fd,TCGETS,@tios);
  2481. end;
  2482. Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean;
  2483. var
  2484. nr:longint;
  2485. begin
  2486. case OptAct of
  2487. TCSANOW : nr:=TCSETS;
  2488. TCSADRAIN : nr:=TCSETSW;
  2489. TCSAFLUSH : nr:=TCSETSF;
  2490. else
  2491. begin
  2492. ErrNo:=Sys_EINVAL;
  2493. TCSetAttr:=false;
  2494. exit;
  2495. end;
  2496. end;
  2497. TCSetAttr:=IOCtl(fd,nr,@Tios);
  2498. end;
  2499. Procedure CFSetISpeed(var tios:TermIOS;speed:Longint);
  2500. begin
  2501. tios.c_cflag:=(tios.c_cflag and (not CBAUD)) or speed;
  2502. end;
  2503. Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint);
  2504. begin
  2505. CFSetISpeed(tios,speed);
  2506. end;
  2507. Procedure CFMakeRaw(var tios:TermIOS);
  2508. begin
  2509. with tios do
  2510. begin
  2511. c_iflag:=c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
  2512. INLCR or IGNCR or ICRNL or IXON));
  2513. c_oflag:=c_oflag and (not OPOST);
  2514. c_lflag:=c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
  2515. c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or CS8;
  2516. end;
  2517. end;
  2518. Function TCSendBreak(fd,duration:longint):boolean;
  2519. begin
  2520. TCSendBreak:=IOCtl(fd,TCSBRK,pointer(duration));
  2521. end;
  2522. Function TCSetPGrp(fd,id:longint):boolean;
  2523. begin
  2524. TCSetPGrp:=IOCtl(fd,TIOCSPGRP,pointer(id));
  2525. end;
  2526. Function TCGetPGrp(fd:longint;var id:longint):boolean;
  2527. begin
  2528. TCGetPGrp:=IOCtl(fd,TIOCGPGRP,@id);
  2529. end;
  2530. Function TCDrain(fd:longint):boolean;
  2531. begin
  2532. TCDrain:=IOCtl(fd,TCSBRK,pointer(1));
  2533. end;
  2534. Function TCFlow(fd,act:longint):boolean;
  2535. begin
  2536. TCFlow:=IOCtl(fd,TCXONC,pointer(act));
  2537. end;
  2538. Function TCFlush(fd,qsel:longint):boolean;
  2539. begin
  2540. TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
  2541. end;
  2542. Function IsATTY(Handle:Longint):Boolean;
  2543. {
  2544. Check if the filehandle described by 'handle' is a TTY (Terminal)
  2545. }
  2546. var
  2547. t : Termios;
  2548. begin
  2549. IsAtty:=TCGetAttr(Handle,t);
  2550. end;
  2551. Function IsATTY(f: text):Boolean;
  2552. {
  2553. Idem as previous, only now for text variables.
  2554. }
  2555. begin
  2556. IsATTY:=IsaTTY(textrec(f).handle);
  2557. end;
  2558. function TTYName(Handle:Longint):string;
  2559. {
  2560. Return the name of the current tty described by handle f.
  2561. returns empty string in case of an error.
  2562. }
  2563. Const
  2564. dev='/dev';
  2565. var
  2566. name : string;
  2567. st : stat;
  2568. mydev,
  2569. myino : longint;
  2570. dirstream : pdir;
  2571. d : pdirent;
  2572. begin
  2573. TTYName:='';
  2574. fstat(handle,st);
  2575. if (errno<>0) and isatty (handle) then
  2576. exit;
  2577. mydev:=st.dev;
  2578. myino:=st.ino;
  2579. dirstream:=opendir(dev);
  2580. if (linuxerror<>0) then
  2581. exit;
  2582. d:=Readdir(dirstream);
  2583. while (d<>nil) do
  2584. begin
  2585. if (d^.ino=myino) then
  2586. begin
  2587. name:=dev+'/'+strpas(@(d^.name));
  2588. fstat(name,st);
  2589. if (linuxerror=0) and (st.dev=mydev) then
  2590. begin
  2591. closedir(dirstream);
  2592. ttyname:=name;
  2593. exit;
  2594. end;
  2595. end;
  2596. d:=Readdir(dirstream);
  2597. end;
  2598. closedir(dirstream);
  2599. end;
  2600. function TTYName(var F:Text):string;
  2601. {
  2602. Idem as previous, only now for text variables;
  2603. }
  2604. begin
  2605. TTYName:=TTYName(textrec(f).handle);
  2606. end;
  2607. {******************************************************************************
  2608. Utility calls
  2609. ******************************************************************************}
  2610. Function Octal(l:longint):longint;
  2611. {
  2612. Convert an octal specified number to decimal;
  2613. }
  2614. var
  2615. octnr,
  2616. oct : longint;
  2617. begin
  2618. octnr:=0;
  2619. oct:=0;
  2620. while (l>0) do
  2621. begin
  2622. oct:=oct or ((l mod 10) shl octnr);
  2623. l:=l div 10;
  2624. inc(octnr,3);
  2625. end;
  2626. Octal:=oct;
  2627. end;
  2628. Function StringToPPChar(Var S:STring):ppchar;
  2629. {
  2630. Create a PPChar to structure of pchars which are the arguments specified
  2631. in the string S. Especially usefull for creating an ArgV for Exec-calls
  2632. }
  2633. var
  2634. nr : longint;
  2635. Buf : ^char;
  2636. p : ppchar;
  2637. begin
  2638. s:=s+#0;
  2639. buf:=@s[1];
  2640. nr:=0;
  2641. while(buf^<>#0) do
  2642. begin
  2643. while (buf^ in [' ',#8,#10]) do
  2644. inc(buf);
  2645. inc(nr);
  2646. while not (buf^ in [' ',#0,#8,#10]) do
  2647. inc(buf);
  2648. end;
  2649. getmem(p,nr*4);
  2650. StringToPPChar:=p;
  2651. if p=nil then
  2652. begin
  2653. LinuxError:=sys_enomem;
  2654. exit;
  2655. end;
  2656. buf:=@s[1];
  2657. while (buf^<>#0) do
  2658. begin
  2659. while (buf^ in [' ',#8,#10]) do
  2660. begin
  2661. buf^:=#0;
  2662. inc(buf);
  2663. end;
  2664. p^:=buf;
  2665. inc(p);
  2666. p^:=nil;
  2667. while not (buf^ in [' ',#0,#8,#10]) do
  2668. inc(buf);
  2669. end;
  2670. end;
  2671. Function FExpand(Const Path:PathStr):PathStr;
  2672. var
  2673. temp : pathstr;
  2674. i,j : longint;
  2675. p : pchar;
  2676. Begin
  2677. {Remove eventual drive - doesn't exist in Linux}
  2678. if path[2]=':' then
  2679. i:=3
  2680. else
  2681. i:=1;
  2682. temp:='';
  2683. {Replace ~/ with $HOME}
  2684. if (path[i]='~') and ((i+1>length(path)) or (path[i+1]='/')) then
  2685. begin
  2686. p:=getenv('HOME');
  2687. if not (p=nil) then
  2688. Insert(StrPas(p),temp,i);
  2689. i:=1;
  2690. temp:=temp+Copy(Path,2,255);
  2691. end;
  2692. {Do we have an absolute path ? No - prefix the current dir}
  2693. if temp='' then
  2694. begin
  2695. if path[i]<>'/' then
  2696. begin
  2697. {$I-}
  2698. getdir(0,temp);
  2699. {$I+}
  2700. if ioresult<>0 then;
  2701. end
  2702. else
  2703. inc(i);
  2704. temp:=temp+'/'+copy(path,i,length(path)-i+1)+'/';
  2705. end;
  2706. {First remove all references to '/./'}
  2707. while pos('/./',temp)<>0 do
  2708. delete(temp,pos('/./',temp),2);
  2709. {Now remove also all references to '/../' + of course previous dirs..}
  2710. repeat
  2711. i:=pos('/../',temp);
  2712. {Find the pos of the previous dir}
  2713. if i>1 then
  2714. begin
  2715. j:=i-1;
  2716. while (j>1) and (temp[j]<>'/') do
  2717. dec (j);{temp[1] is always '/'}
  2718. delete(temp,j,i-j+3);
  2719. end
  2720. else
  2721. if i=1 then {i=1, so we have temp='/../something', just delete '/../'}
  2722. delete(temp,1,3);
  2723. until i=0;
  2724. { Remove ending /.. }
  2725. i:=pos('/..',temp);
  2726. if (i<>0) and (i =length(temp)-2) then
  2727. begin
  2728. j:=i-1;
  2729. while (j>1) and (temp[j]<>'/') do
  2730. dec (j);
  2731. delete (temp,j,i-j+3);
  2732. end;
  2733. { if last character is / then remove it - dir is also a file :-) }
  2734. if (length(temp)>0) and (temp[length(temp)]='/') then
  2735. dec(byte(temp[0]));
  2736. fexpand:=temp;
  2737. End;
  2738. Function FSearch(const path:pathstr;dirlist:string):pathstr;
  2739. {
  2740. Searches for a file 'path' in the list of direcories in 'dirlist'.
  2741. returns an empty string if not found. Wildcards are NOT allowed.
  2742. If dirlist is empty, it is set to '.'
  2743. }
  2744. Var
  2745. NewDir : PathStr;
  2746. p1 : Longint;
  2747. Info : Stat;
  2748. Begin
  2749. {Replace ':' with ';'}
  2750. for p1:=1to length(dirlist) do
  2751. if dirlist[p1]=':' then
  2752. dirlist[p1]:=';';
  2753. {Check for WildCards}
  2754. If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
  2755. FSearch:='' {No wildcards allowed in these things.}
  2756. Else
  2757. Begin
  2758. Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
  2759. Repeat
  2760. p1:=Pos(';',DirList);
  2761. If p1=0 Then
  2762. p1:=255;
  2763. NewDir:=Copy(DirList,1,P1 - 1);
  2764. if NewDir[Length(NewDir)]<>'/' then
  2765. NewDir:=NewDir+'/';
  2766. NewDir:=NewDir+Path;
  2767. Delete(DirList,1,p1);
  2768. if FStat(NewDir,Info) then
  2769. Begin
  2770. If Pos('./',NewDir)=1 Then
  2771. Delete(NewDir,1,2);
  2772. {DOS strips off an initial .\}
  2773. End
  2774. Else
  2775. NewDir:='';
  2776. Until (DirList='') or (Length(NewDir) > 0);
  2777. FSearch:=NewDir;
  2778. End;
  2779. End;
  2780. Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
  2781. Var
  2782. DotPos,SlashPos,i : longint;
  2783. Begin
  2784. SlashPos:=0;
  2785. DotPos:=256;
  2786. i:=Length(Path);
  2787. While (i>0) and (SlashPos=0) Do
  2788. Begin
  2789. If (DotPos=256) and (Path[i]='.') Then
  2790. DotPos:=i;
  2791. If (Path[i]='/') Then
  2792. SlashPos:=i;
  2793. Dec(i);
  2794. End;
  2795. Ext:=Copy(Path,DotPos,255);
  2796. Dir:=Copy(Path,1,SlashPos);
  2797. Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
  2798. End;
  2799. Function Dirname(Const path:pathstr):pathstr;
  2800. {
  2801. This function returns the directory part of a complete path.
  2802. Unless the directory is root '/', The last character is not
  2803. a slash.
  2804. }
  2805. var
  2806. Dir : PathStr;
  2807. Name : NameStr;
  2808. Ext : ExtStr;
  2809. begin
  2810. FSplit(Path,Dir,Name,Ext);
  2811. if length(Dir)>1 then
  2812. Delete(Dir,length(Dir),1);
  2813. DirName:=Dir;
  2814. end;
  2815. Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
  2816. {
  2817. This function returns the filename part of a complete path. If suf is
  2818. supplied, it is cut off the filename.
  2819. }
  2820. var
  2821. Dir : PathStr;
  2822. Name : NameStr;
  2823. Ext : ExtStr;
  2824. begin
  2825. FSplit(Path,Dir,Name,Ext);
  2826. if Suf<>Ext then
  2827. Name:=Name+Ext;
  2828. BaseName:=Name;
  2829. end;
  2830. Function FNMatch(const Pattern,Name:string):Boolean;
  2831. Var
  2832. LenPat,LenName : longint;
  2833. Function DoFNMatch(i,j:longint):Boolean;
  2834. Var
  2835. Found : boolean;
  2836. Begin
  2837. Found:=true;
  2838. While Found and (i<=LenPat) Do
  2839. Begin
  2840. Case Pattern[i] of
  2841. '?' : Found:=(j<=LenName);
  2842. '*' : Begin
  2843. {find the next character in pattern, different of ? and *}
  2844. while Found and (i<LenPat) do
  2845. begin
  2846. inc(i);
  2847. case Pattern[i] of
  2848. '*' : ;
  2849. '?' : begin
  2850. inc(j);
  2851. Found:=(j<=LenName);
  2852. end;
  2853. else
  2854. Found:=false;
  2855. end;
  2856. end;
  2857. {Now, find in name the character which i points to, if the * or ?
  2858. wasn't the last character in the pattern, else, use up all the
  2859. chars in name}
  2860. Found:=true;
  2861. if (i<=LenPat) then
  2862. begin
  2863. repeat
  2864. {find a letter (not only first !) which maches pattern[i]}
  2865. while (j<=LenName) and (name[j]<>pattern[i]) do
  2866. inc (j);
  2867. if (j<LenName) then
  2868. begin
  2869. if DoFnMatch(i+1,j+1) then
  2870. begin
  2871. i:=LenPat;
  2872. j:=LenName;{we can stop}
  2873. Found:=true;
  2874. end
  2875. else
  2876. inc(j);{We didn't find one, need to look further}
  2877. end;
  2878. until (j>=LenName);
  2879. end
  2880. else
  2881. j:=LenName;{we can stop}
  2882. end;
  2883. else {not a wildcard character in pattern}
  2884. Found:=(j<=LenName) and (pattern[i]=name[j]);
  2885. end;
  2886. inc(i);
  2887. inc(j);
  2888. end;
  2889. DoFnMatch:=Found and (j>LenName);
  2890. end;
  2891. Begin {start FNMatch}
  2892. LenPat:=Length(Pattern);
  2893. LenName:=Length(Name);
  2894. FNMatch:=DoFNMatch(1,1);
  2895. End;
  2896. Procedure Globfree(var p : pglob);
  2897. {
  2898. Release memory occupied by pglob structure, and names in it.
  2899. sets p to nil.
  2900. }
  2901. var
  2902. temp : pglob;
  2903. begin
  2904. while assigned(p) do
  2905. begin
  2906. temp:=p^.next;
  2907. if assigned(p^.name) then
  2908. freemem(p^.name);
  2909. dispose(p);
  2910. p:=temp;
  2911. end;
  2912. end;
  2913. Function Glob(Const path:pathstr):pglob;
  2914. {
  2915. Fills a tglob structure with entries matching path,
  2916. and returns a pointer to it. Returns nil on error,
  2917. linuxerror is set accordingly.
  2918. }
  2919. var
  2920. temp,
  2921. temp2 : string[255];
  2922. thedir : pdir;
  2923. buffer : pdirent;
  2924. root,
  2925. current : pglob;
  2926. begin
  2927. { Get directory }
  2928. temp:=dirname(path);
  2929. if temp='' then
  2930. temp:='.';
  2931. temp:=temp+#0;
  2932. thedir:=opendir(@temp[1]);
  2933. if thedir=nil then
  2934. begin
  2935. glob:=nil;
  2936. linuxerror:=errno;
  2937. exit;
  2938. end;
  2939. temp:=basename(path,''); { get the pattern }
  2940. if thedir^.fd<0 then
  2941. begin
  2942. linuxerror:=errno;
  2943. glob:=nil;
  2944. exit;
  2945. end;
  2946. {get the entries}
  2947. root:=nil;
  2948. current:=nil;
  2949. repeat
  2950. buffer:=Sys_readdir(thedir);
  2951. if buffer=nil then
  2952. break;
  2953. temp2:=strpas(@(buffer^.name[0]));
  2954. if fnmatch(temp,temp2) then
  2955. begin
  2956. if root=nil then
  2957. begin
  2958. new(root);
  2959. current:=root;
  2960. end
  2961. else
  2962. begin
  2963. new(current^.next);
  2964. current:=current^.next;
  2965. end;
  2966. if current=nil then
  2967. begin
  2968. linuxerror:=Sys_ENOMEM;
  2969. globfree(root);
  2970. break;
  2971. end;
  2972. current^.next:=nil;
  2973. getmem(current^.name,length(temp2)+1);
  2974. if current^.name=nil then
  2975. begin
  2976. linuxerror:=Sys_ENOMEM;
  2977. globfree(root);
  2978. break;
  2979. end;
  2980. move(buffer^.name[0],current^.name^,length(temp2)+1);
  2981. end;
  2982. until false;
  2983. closedir(thedir);
  2984. glob:=root;
  2985. end;
  2986. {--------------------------------
  2987. FiledescriptorSets
  2988. --------------------------------}
  2989. Procedure FD_Zero(var fds:fdSet);
  2990. {
  2991. Clear the set of filedescriptors
  2992. }
  2993. begin
  2994. FillChar(fds,sizeof(fdSet),0);
  2995. end;
  2996. Procedure FD_Clr(fd:longint;var fds:fdSet);
  2997. {
  2998. Remove fd from the set of filedescriptors
  2999. }
  3000. begin
  3001. fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
  3002. end;
  3003. Procedure FD_Set(fd:longint;var fds:fdSet);
  3004. {
  3005. Add fd to the set of filedescriptors
  3006. }
  3007. begin
  3008. fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
  3009. end;
  3010. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  3011. {
  3012. Test if fd is part of the set of filedescriptors
  3013. }
  3014. begin
  3015. FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
  3016. end;
  3017. Function GetFS (var T:Text):longint;
  3018. {
  3019. Get File Descriptor of a text file.
  3020. }
  3021. begin
  3022. if textrec(t).mode=fmclosed then
  3023. exit(-1)
  3024. else
  3025. GETFS:=textrec(t).Handle
  3026. end;
  3027. Function GetFS(Var F:File):longint;
  3028. {
  3029. Get File Descriptor of an unTyped file.
  3030. }
  3031. begin
  3032. { Handle and mode are on the same place in textrec and filerec. }
  3033. if filerec(f).mode=fmclosed then
  3034. exit(-1)
  3035. else
  3036. GETFS:=filerec(f).Handle
  3037. end;
  3038. {--------------------------------
  3039. Stat.Mode Macro's
  3040. --------------------------------}
  3041. Function S_ISLNK(m:word):boolean;
  3042. {
  3043. Check mode field of inode for link.
  3044. }
  3045. begin
  3046. S_ISLNK:=(m and STAT_IFMT)=STAT_IFLNK;
  3047. end;
  3048. Function S_ISREG(m:word):boolean;
  3049. {
  3050. Check mode field of inode for regular file.
  3051. }
  3052. begin
  3053. S_ISREG:=(m and STAT_IFMT)=STAT_IFREG;
  3054. end;
  3055. Function S_ISDIR(m:word):boolean;
  3056. {
  3057. Check mode field of inode for directory.
  3058. }
  3059. begin
  3060. S_ISDIR:=(m and STAT_IFMT)=STAT_IFDIR;
  3061. end;
  3062. Function S_ISCHR(m:word):boolean;
  3063. {
  3064. Check mode field of inode for character device.
  3065. }
  3066. begin
  3067. S_ISCHR:=(m and STAT_IFMT)=STAT_IFCHR;
  3068. end;
  3069. Function S_ISBLK(m:word):boolean;
  3070. {
  3071. Check mode field of inode for block device.
  3072. }
  3073. begin
  3074. S_ISBLK:=(m and STAT_IFMT)=STAT_IFBLK;
  3075. end;
  3076. Function S_ISFIFO(m:word):boolean;
  3077. {
  3078. Check mode field of inode for named pipe (FIFO).
  3079. }
  3080. begin
  3081. S_ISFIFO:=(m and STAT_IFMT)=STAT_IFIFO;
  3082. end;
  3083. Function S_ISSOCK(m:word):boolean;
  3084. {
  3085. Check mode field of inode for socket.
  3086. }
  3087. begin
  3088. S_ISSOCK:=(m and STAT_IFMT)=STAT_IFSOCK;
  3089. end;
  3090. {--------------------------------
  3091. Memory functions
  3092. --------------------------------}
  3093. function MMap(const m:tmmapargs):longint;
  3094. Var
  3095. Sr : Syscallregs;
  3096. begin
  3097. Sr.reg2:=longint(@m);
  3098. MMap:=syscall(syscall_nr_mmap,sr);
  3099. LinuxError:=Errno;
  3100. end;
  3101. {--------------------------------
  3102. Port IO functions
  3103. --------------------------------}
  3104. Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
  3105. {
  3106. Set permissions on NUM ports starting with port FROM to VALUE
  3107. this works ONLY as root.
  3108. }
  3109. Var
  3110. Sr : Syscallregs;
  3111. begin
  3112. Sr.Reg2:=From;
  3113. Sr.Reg3:=Num;
  3114. Sr.Reg4:=Value;
  3115. IOPerm:=Syscall(Syscall_nr_ioperm,sr)=0;
  3116. LinuxError:=Errno;
  3117. end;
  3118. {$IFDEF I386}
  3119. Procedure WritePort (Port : Longint; Value : Byte);
  3120. {
  3121. Writes 'Value' to port 'Port'
  3122. }
  3123. begin
  3124. asm
  3125. movl port,%edx
  3126. movb value,%al
  3127. outb %al,%dx
  3128. end ['EAX','EDX'];
  3129. end;
  3130. Procedure WritePort (Port : Longint; Value : Word);
  3131. {
  3132. Writes 'Value' to port 'Port'
  3133. }
  3134. begin
  3135. asm
  3136. movl port,%edx
  3137. movw value,%ax
  3138. outw %ax,%dx
  3139. end ['EAX','EDX'];
  3140. end;
  3141. Procedure WritePort (Port : Longint; Value : Longint);
  3142. {
  3143. Writes 'Value' to port 'Port'
  3144. }
  3145. begin
  3146. asm
  3147. movl port,%edx
  3148. movl value,%eax
  3149. outl %eax,%dx
  3150. end ['EAX','EDX'];
  3151. end;
  3152. Procedure WritePortB (Port : Longint; Value : Byte);
  3153. {
  3154. Writes 'Value' to port 'Port'
  3155. }
  3156. begin
  3157. asm
  3158. movl port,%edx
  3159. movb value,%al
  3160. outb %al,%dx
  3161. end ['EAX','EDX'];
  3162. end;
  3163. Procedure WritePortW (Port : Longint; Value : Word);
  3164. {
  3165. Writes 'Value' to port 'Port'
  3166. }
  3167. begin
  3168. asm
  3169. movl port,%edx
  3170. movw value,%ax
  3171. outw %ax,%dx
  3172. end ['EAX','EDX'];
  3173. end;
  3174. Procedure WritePortL (Port : Longint; Value : Longint);
  3175. {
  3176. Writes 'Value' to port 'Port'
  3177. }
  3178. begin
  3179. asm
  3180. movl port,%edx
  3181. movl value,%eax
  3182. outl %eax,%dx
  3183. end ['EAX','EDX'];
  3184. end;
  3185. Procedure WritePortl (Port : Longint; Var Buf; Count: longint);
  3186. {
  3187. Writes 'Count' longints from 'Buf' to Port
  3188. }
  3189. begin
  3190. asm
  3191. movl count,%ecx
  3192. movl buf,%esi
  3193. movl port,%edx
  3194. cld
  3195. rep
  3196. outsl
  3197. end ['ECX','ESI','EDX'];
  3198. end;
  3199. Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
  3200. {
  3201. Writes 'Count' words from 'Buf' to Port
  3202. }
  3203. begin
  3204. asm
  3205. movl count,%ecx
  3206. movl buf,%esi
  3207. movl port,%edx
  3208. cld
  3209. rep
  3210. outsw
  3211. end ['ECX','ESI','EDX'];
  3212. end;
  3213. Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
  3214. {
  3215. Writes 'Count' bytes from 'Buf' to Port
  3216. }
  3217. begin
  3218. asm
  3219. movl count,%ecx
  3220. movl buf,%esi
  3221. movl port,%edx
  3222. cld
  3223. rep
  3224. outsb
  3225. end ['ECX','ESI','EDX'];
  3226. end;
  3227. Procedure ReadPort (Port : Longint; Var Value : Byte);
  3228. {
  3229. Reads 'Value' from port 'Port'
  3230. }
  3231. begin
  3232. asm
  3233. movl port,%edx
  3234. inb %dx,%al
  3235. movl value,%edx
  3236. movb %al,(%edx)
  3237. end ['EAX','EDX'];
  3238. end;
  3239. Procedure ReadPort (Port : Longint; Var Value : Word);
  3240. {
  3241. Reads 'Value' from port 'Port'
  3242. }
  3243. begin
  3244. asm
  3245. movl port,%edx
  3246. inw %dx,%ax
  3247. movl value,%edx
  3248. movw %ax,(%edx)
  3249. end ['EAX','EDX'];
  3250. end;
  3251. Procedure ReadPort (Port : Longint; Var Value : Longint);
  3252. {
  3253. Reads 'Value' from port 'Port'
  3254. }
  3255. begin
  3256. asm
  3257. movl port,%edx
  3258. inl %dx,%eax
  3259. movl value,%edx
  3260. movl %eax,(%edx)
  3261. end ['EAX','EDX'];
  3262. end;
  3263. function ReadPortB (Port : Longint): Byte; assembler;
  3264. {
  3265. Reads a byte from port 'Port'
  3266. }
  3267. asm
  3268. xorl %eax,%eax
  3269. movl port,%edx
  3270. inb %dx,%al
  3271. end ['EAX','EDX'];
  3272. function ReadPortW (Port : Longint): Word; assembler;
  3273. {
  3274. Reads a word from port 'Port'
  3275. }
  3276. asm
  3277. xorl %eax,%eax
  3278. movl port,%edx
  3279. inw %dx,%ax
  3280. end ['EAX','EDX'];
  3281. function ReadPortL (Port : Longint): LongInt; assembler;
  3282. {
  3283. Reads a LongInt from port 'Port'
  3284. }
  3285. asm
  3286. movl port,%edx
  3287. inl %dx,%eax
  3288. end ['EAX','EDX'];
  3289. Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
  3290. {
  3291. Reads 'Count' longints from port 'Port' to 'Buf'.
  3292. }
  3293. begin
  3294. asm
  3295. movl count,%ecx
  3296. movl buf,%edi
  3297. movl port,%edx
  3298. cld
  3299. rep
  3300. insl
  3301. end ['ECX','EDI','EDX'];
  3302. end;
  3303. Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
  3304. {
  3305. Reads 'Count' words from port 'Port' to 'Buf'.
  3306. }
  3307. begin
  3308. asm
  3309. movl count,%ecx
  3310. movl buf,%edi
  3311. movl port,%edx
  3312. cld
  3313. rep
  3314. insw
  3315. end ['ECX','EDI','EDX'];
  3316. end;
  3317. Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
  3318. {
  3319. Reads 'Count' bytes from port 'Port' to 'Buf'.
  3320. }
  3321. begin
  3322. asm
  3323. movl count,%ecx
  3324. movl buf,%edi
  3325. movl port,%edx
  3326. cld
  3327. rep
  3328. insb
  3329. end ['ECX','EDI','EDX'];
  3330. end;
  3331. {$ENDIF}
  3332. Initialization
  3333. InitLocalTime;
  3334. finalization
  3335. DoneLocalTime;
  3336. End.
  3337. {
  3338. $Log$
  3339. Revision 1.66 2000-03-27 13:25:48 jonas
  3340. * fixed readport* functions (thanks Florian ;)
  3341. Revision 1.65 2000/03/23 17:10:32 jonas
  3342. * fixes for port reading
  3343. Revision 1.64 2000/03/17 13:27:00 sg
  3344. * Added WritePort[B|W|L] for single data access
  3345. * Added ReadPort[B|W|L] functions
  3346. Revision 1.63 2000/02/23 17:19:06 peter
  3347. + readded getepochtime which simply calls gettimeofday
  3348. Revision 1.62 2000/02/09 23:09:13 peter
  3349. * rewrote glob to be much simpler and cleaner, the old code did
  3350. strange complex things with pointers which was unnecessary
  3351. Revision 1.61 2000/02/09 16:59:31 peter
  3352. * truncated log
  3353. Revision 1.60 2000/02/08 12:05:58 peter
  3354. + readlink
  3355. Revision 1.59 2000/01/07 16:41:40 daniel
  3356. * copyright 2000
  3357. Revision 1.58 2000/01/07 16:32:26 daniel
  3358. * copyright 2000 added
  3359. Revision 1.57 2000/01/04 12:56:09 jonas
  3360. * fixed modified registers for port routines
  3361. Revision 1.56 1999/12/28 09:38:07 sg
  3362. * the long version of AssignStream now sets the result value to -1 in
  3363. _all_ cases when it would fail.
  3364. Revision 1.55 1999/12/08 01:03:54 peter
  3365. * overloaded gettime functions supporting hsec and msec,usec
  3366. Revision 1.54 1999/12/01 22:46:59 peter
  3367. + timezone support
  3368. Revision 1.53 1999/11/14 21:35:04 peter
  3369. * removed warnings
  3370. Revision 1.52 1999/11/14 11:11:15 michael
  3371. + Added Pause() and alarm()
  3372. Revision 1.51 1999/11/11 19:43:49 sg
  3373. * fixed severe bug: change by ? in dup2 (flushing) resulted in broken
  3374. AssignStream functions
  3375. Revision 1.50 1999/11/06 14:39:12 peter
  3376. * truncated log
  3377. Revision 1.49 1999/10/28 09:48:31 peter
  3378. + mmap
  3379. Revision 1.48 1999/10/22 10:37:44 peter
  3380. * fixed sigset
  3381. Revision 1.47 1999/10/06 17:43:58 peter
  3382. * freemem with wrong size (found with the new heapmanager)
  3383. Revision 1.46 1999/09/08 16:14:41 peter
  3384. * pointer fixes
  3385. Revision 1.45 1999/08/11 22:02:25 peter
  3386. * removed old integer versions of localtoepoch and epochtolocal, you
  3387. need to use the word versions instead else you got an overloaded bug
  3388. Revision 1.44 1999/07/31 23:55:04 michael
  3389. + FCNTL patch from Sebastian Guenther
  3390. Revision 1.43 1999/07/29 16:33:24 michael
  3391. + Yet more Fixes to assignstream with rerouting of stderr
  3392. Revision 1.42 1999/07/29 15:55:54 michael
  3393. + Fixes to assignstream with rerouting of stderr, by Sebastian Guenther
  3394. Revision 1.41 1999/07/29 15:53:55 michael
  3395. + Added assignstream with rerouting of stderr, by Sebastian Guenther
  3396. }