linux.pp 85 KB

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