linux.pp 84 KB

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