linux.pp 84 KB

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