linux.pp 84 KB

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