linux.pp 86 KB

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