linux.pp 85 KB

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