linux.pp 84 KB

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