IdStackVCLPosix.pas 50 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569
  1. unit IdStackVCLPosix;
  2. interface
  3. {$I IdCompilerDefines.inc}
  4. {IMPORTANT!!!
  5. Platform warnings in this unit should be disabled because Indy we have no
  6. intention of porting this unit to Windows or any non-Unix-like operating system.
  7. Any differences between Unix-like operating systems have to dealt with in other
  8. ways.
  9. }
  10. {$I IdSymbolPlatformOff.inc}
  11. {$I IdUnitPlatformOff.inc}
  12. uses
  13. Classes,
  14. IdCTypes,
  15. Posix.SysSelect,
  16. Posix.SysSocket,
  17. Posix.SysTime,
  18. IdStack,
  19. IdStackConsts,
  20. IdGlobal,
  21. IdStackBSDBase;
  22. type
  23. {$IFDEF ANDROID}
  24. EIdAccessWifiStatePermissionNeeded = class(EIdAndroidPermissionNeeded);
  25. EIdAccessNetworkStatePermissionNeeded = class(EIdAndroidPermissionNeeded);
  26. {$ENDIF}
  27. TIdStackVCLPosix = class(TIdStackBSDBase)
  28. protected
  29. procedure WriteChecksumIPv6(s: TIdStackSocketHandle; var VBuffer: TIdBytes;
  30. const AOffset: Integer; const AIP: String; const APort: TIdPort);
  31. function GetLastError: Integer;
  32. procedure SetLastError(const AError: Integer);
  33. function HostByName(const AHostName: string;
  34. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
  35. function ReadHostName: string; override;
  36. function WSCloseSocket(ASocket: TIdStackSocketHandle): Integer; override;
  37. function WSRecv(ASocket: TIdStackSocketHandle; var ABuffer;
  38. const ABufferLength, AFlags: Integer): Integer; override;
  39. function WSSend(ASocket: TIdStackSocketHandle; const ABuffer;
  40. const ABufferLength, AFlags: Integer): Integer; override;
  41. function WSShutdown(ASocket: TIdStackSocketHandle; AHow: Integer): Integer; override;
  42. {$IFNDEF DCC_XE3_OR_ABOVE}
  43. procedure WSGetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  44. AOptName: TIdSocketOption; var AOptVal; var AOptLen: Integer); override;
  45. procedure WSSetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  46. AOptName: TIdSocketOption; const AOptVal; const AOptLen: Integer); override;
  47. {$ENDIF}
  48. public
  49. constructor Create; override;
  50. destructor Destroy; override;
  51. procedure SetBlocking(ASocket: TIdStackSocketHandle; const ABlocking: Boolean); override;
  52. function WouldBlock(const AResult: Integer): Boolean; override;
  53. function Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort;
  54. var VIPVersion: TIdIPVersion): TIdStackSocketHandle; override;
  55. procedure Bind(ASocket: TIdStackSocketHandle; const AIP: string;
  56. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  57. procedure Connect(const ASocket: TIdStackSocketHandle; const AIP: string;
  58. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  59. function HostByAddress(const AAddress: string;
  60. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
  61. function WSGetLastError: Integer; override;
  62. procedure WSSetLastError(const AErr : Integer); override;
  63. function WSGetServByName(const AServiceName: string): TIdPort; override;
  64. procedure AddServByPortToList(const APortNumber: TIdPort; AAddresses: TStrings); override;
  65. procedure GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string;
  66. var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
  67. procedure GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string;
  68. var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
  69. procedure Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer); override;
  70. function HostToNetwork(AValue: UInt16): UInt16; override;
  71. function NetworkToHost(AValue: UInt16): UInt16; override;
  72. function HostToNetwork(AValue: UInt32): UInt32; override;
  73. function NetworkToHost(AValue: UInt32): UInt32; override;
  74. function HostToNetwork(AValue: UInt64): UInt64; override;
  75. function NetworkToHost(AValue: UInt64): UInt64; override;
  76. function RecvFrom(const ASocket: TIdStackSocketHandle;
  77. var VBuffer; const ALength, AFlags: Integer; var VIP: string;
  78. var VPort: TIdPort; var VIPVersion: TIdIPVersion): Integer; override;
  79. function ReceiveMsg(ASocket: TIdStackSocketHandle;
  80. var VBuffer: TIdBytes; APkt: TIdPacketInfo): UInt32; override;
  81. procedure WSSendTo(ASocket: TIdStackSocketHandle; const ABuffer;
  82. const ABufferLength, AFlags: Integer; const AIP: string; const APort: TIdPort;
  83. AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  84. function WSSocket(AFamily : Integer; AStruct : TIdSocketType; AProtocol: Integer;
  85. const ANonBlocking: Boolean = False): TIdStackSocketHandle; override;
  86. procedure Disconnect(ASocket: TIdStackSocketHandle); override;
  87. {$IFDEF DCC_XE3_OR_ABOVE}
  88. procedure GetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  89. AOptName: TIdSocketOption; var AOptVal; var AOptLen: Integer); override;
  90. procedure SetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  91. AOptName: TIdSocketOption; const AOptVal; const AOptLen: Integer); override;
  92. {$ENDIF}
  93. function SupportsIPv4: Boolean; overload; override;
  94. function SupportsIPv6: Boolean; overload; override;
  95. function CheckIPVersionSupport(const AIPVersion: TIdIPVersion): boolean; override;
  96. //In Windows, this writes a checksum into a buffer. In Linux, it would probably
  97. //simply have the kernal write the checksum with something like this (RFC 2292):
  98. //
  99. // int offset = 2;
  100. // setsockopt(fd, IPPROTO_IPV6, IPV6_CHECKSUM, &offset, sizeof(offset));
  101. //
  102. // Note that this should be called
  103. //IMMEDIATELY before you do a SendTo because the Local IPv6 address might change
  104. procedure WriteChecksum(s : TIdStackSocketHandle; var VBuffer : TIdBytes;
  105. const AOffset : Integer; const AIP : String; const APort : TIdPort;
  106. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  107. function IOControl(const s: TIdStackSocketHandle; const cmd: UInt32;
  108. var arg: UInt32): Integer; override;
  109. procedure GetLocalAddressList(AAddresses: TIdStackLocalAddressList); override;
  110. end;
  111. implementation
  112. {$I IdOptimizationsOff.inc}
  113. uses
  114. IdResourceStrings,
  115. IdResourceStringsUnix,
  116. IdResourceStringsVCLPosix,
  117. IdException,
  118. IdVCLPosixSupplemental,
  119. Posix.Base,
  120. Posix.ArpaInet,
  121. Posix.Errno,
  122. Posix.NetDB,
  123. {$IF DEFINED(HAS_getifaddrs)}
  124. Posix.NetIf,
  125. {$ELSEIF DEFINED(ANDROID)}
  126. //IdIfAddrs,
  127. {$IFEND}
  128. Posix.NetinetIn,
  129. Posix.StrOpts,
  130. Posix.SysTypes,
  131. Posix.SysUio,
  132. Posix.Unistd,
  133. Posix.Fcntl,
  134. SysUtils;
  135. {$UNDEF HAS_MSG_NOSIGNAL}
  136. {$IFDEF LINUX} //this LINUX ifdef is deliberate
  137. {$DEFINE HAS_MSG_NOSIGNAL}
  138. {$ENDIF}
  139. const
  140. {$IFDEF HAS_MSG_NOSIGNAL}
  141. //fancy little trick since OS X does not have MSG_NOSIGNAL
  142. Id_MSG_NOSIGNAL = MSG_NOSIGNAL;
  143. {$ELSE}
  144. Id_MSG_NOSIGNAL = 0;
  145. {$ENDIF}
  146. Id_WSAEPIPE = EPIPE;
  147. //helper functions for some structs
  148. {Note: These hide an API difference in structures.
  149. BSD 4.4 introduced a minor API change. sa_family was changed from a 16bit
  150. word to an 8 bit byteee and an 8 bit byte feild named sa_len was added.
  151. }
  152. procedure InitSockAddr_In(var VSock : SockAddr_In);
  153. {$IFDEF USE_INLINE} inline; {$ENDIF}
  154. begin
  155. FillChar(VSock, SizeOf(SockAddr_In), 0);
  156. VSock.sin_family := PF_INET;
  157. {$IFDEF SOCK_HAS_SINLEN}
  158. VSock.sin_len := SizeOf(SockAddr_In);
  159. {$ENDIF}
  160. end;
  161. procedure InitSockAddr_in6(var VSock : SockAddr_in6);
  162. {$IFDEF USE_INLINE} inline; {$ENDIF}
  163. begin
  164. FillChar(VSock, SizeOf(SockAddr_in6), 0);
  165. {$IFDEF SOCK_HAS_SINLEN}
  166. VSock.sin6_len := SizeOf(SockAddr_in6);
  167. {$ENDIF}
  168. VSock.sin6_family := PF_INET6;
  169. end;
  170. //
  171. { TIdSocketListVCLPosix }
  172. type
  173. TIdSocketListVCLPosix = class (TIdSocketList)
  174. protected
  175. FCount: Integer;
  176. FFDSet: fd_set;
  177. //
  178. class function FDSelect(AReadSet, AWriteSet,
  179. AExceptSet: Pfd_set; const ATimeout: Integer): Integer;
  180. function GetItem(AIndex: Integer): TIdStackSocketHandle; override;
  181. public
  182. procedure Add(AHandle: TIdStackSocketHandle); override;
  183. procedure Remove(AHandle: TIdStackSocketHandle); override;
  184. function Count: Integer; override;
  185. procedure Clear; override;
  186. function Clone: TIdSocketList; override;
  187. function ContainsSocket(AHandle: TIdStackSocketHandle): Boolean; override;
  188. procedure GetFDSet(var VSet: fd_set);
  189. procedure SetFDSet(var VSet: fd_set);
  190. class function Select(AReadList: TIdSocketList; AWriteList: TIdSocketList;
  191. AExceptList: TIdSocketList; const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  192. function SelectRead(const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  193. function SelectReadList(var VSocketList: TIdSocketList;
  194. const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  195. end;
  196. procedure TIdSocketListVCLPosix.Add(AHandle: TIdStackSocketHandle);
  197. begin
  198. Lock;
  199. try
  200. if not __FD_ISSET(AHandle, FFDSet) then begin
  201. if AHandle >= FD_SETSIZE then begin
  202. raise EIdStackSetSizeExceeded.Create(RSSetSizeExceeded);
  203. end;
  204. __FD_SET(AHandle, FFDSet);
  205. Inc(FCount);
  206. end;
  207. finally
  208. Unlock;
  209. end;
  210. end;
  211. procedure TIdSocketListVCLPosix.Clear;
  212. begin
  213. Lock;
  214. try
  215. __FD_ZERO(FFDSet);
  216. FCount := 0;
  217. finally
  218. Unlock;
  219. end;
  220. end;
  221. function TIdSocketListVCLPosix.Clone: TIdSocketList;
  222. begin
  223. Result := TIdSocketListVCLPosix.Create;
  224. try
  225. Lock;
  226. try
  227. TIdSocketListVCLPosix(Result).SetFDSet(FFDSet);
  228. finally
  229. Unlock;
  230. end;
  231. except
  232. Result.Free;
  233. raise;
  234. end;
  235. end;
  236. function TIdSocketListVCLPosix.ContainsSocket(
  237. AHandle: TIdStackSocketHandle): Boolean;
  238. begin
  239. Lock;
  240. try
  241. Result := __FD_ISSET(AHandle, FFDSet);
  242. finally
  243. Unlock;
  244. end;
  245. end;
  246. function TIdSocketListVCLPosix.Count: Integer;
  247. begin
  248. Lock;
  249. try
  250. Result := FCount;
  251. finally
  252. Unlock;
  253. end;
  254. end;
  255. class function TIdSocketListVCLPosix.FDSelect(AReadSet, AWriteSet,
  256. AExceptSet: Pfd_set; const ATimeout: Integer): Integer;
  257. var
  258. LTime: TimeVal;
  259. LTimePtr: PTimeVal;
  260. begin
  261. if ATimeout = IdTimeoutInfinite then begin
  262. LTimePtr := nil;
  263. end else begin
  264. LTime.tv_sec := ATimeout div 1000;
  265. LTime.tv_usec := (ATimeout mod 1000) * 1000;
  266. LTimePtr := @LTime;
  267. end;
  268. // TODO: calculate the actual nfds value based on the Sets provided...
  269. // TODO: use poll() instead of select() to remove limit on how many sockets can be queried
  270. Result := Posix.SysSelect.select(FD_SETSIZE, AReadSet, AWriteSet, AExceptSet, LTimePtr);
  271. end;
  272. procedure TIdSocketListVCLPosix.GetFDSet(var VSet: fd_set);
  273. begin
  274. Lock;
  275. try
  276. VSet := FFDSet;
  277. finally
  278. Unlock;
  279. end;
  280. end;
  281. function TIdSocketListVCLPosix.GetItem(AIndex: Integer): TIdStackSocketHandle;
  282. var
  283. LIndex, i: Integer;
  284. begin
  285. Result := 0;
  286. Lock;
  287. try
  288. LIndex := 0;
  289. //? use FMaxHandle div x
  290. for i:= 0 to FD_SETSIZE - 1 do begin
  291. if __FD_ISSET(i, FFDSet) then begin
  292. if LIndex = AIndex then begin
  293. Result := i;
  294. Break;
  295. end;
  296. Inc(LIndex);
  297. end;
  298. end;
  299. finally
  300. Unlock;
  301. end;
  302. end;
  303. procedure TIdSocketListVCLPosix.Remove(AHandle: TIdStackSocketHandle);
  304. begin
  305. Lock;
  306. try
  307. if __FD_ISSET(AHandle, FFDSet) then begin
  308. Dec(FCount);
  309. __FD_CLR(AHandle, FFDSet);
  310. end;
  311. finally
  312. Unlock;
  313. end;
  314. end;
  315. class function TIdSocketListVCLPosix.Select(AReadList, AWriteList,
  316. AExceptList: TIdSocketList; const ATimeout: Integer): Boolean;
  317. var
  318. LReadSet: fd_set;
  319. LWriteSet: fd_set;
  320. LExceptSet: fd_set;
  321. LPReadSet: Pfd_set;
  322. LPWriteSet: Pfd_set;
  323. LPExceptSet: Pfd_set;
  324. procedure ReadSet(AList: TIdSocketList; var ASet: fd_set; var APSet: Pfd_set);
  325. begin
  326. if AList <> nil then begin
  327. TIdSocketListVCLPosix(AList).GetFDSet(ASet);
  328. APSet := @ASet;
  329. end else begin
  330. APSet := nil;
  331. end;
  332. end;
  333. begin
  334. ReadSet(AReadList, LReadSet, LPReadSet);
  335. ReadSet(AWriteList, LWriteSet, LPWriteSet);
  336. ReadSet(AExceptList, LExceptSet, LPExceptSet);
  337. //
  338. Result := FDSelect(LPReadSet, LPWriteSet, LPExceptSet, ATimeout) >0;
  339. //
  340. if AReadList <> nil then begin
  341. TIdSocketListVCLPosix(AReadList).SetFDSet(LReadSet);
  342. end;
  343. if AWriteList <> nil then begin
  344. TIdSocketListVCLPosix(AWriteList).SetFDSet(LWriteSet);
  345. end;
  346. if AExceptList <> nil then begin
  347. TIdSocketListVCLPosix(AExceptList).SetFDSet(LExceptSet);
  348. end;
  349. end;
  350. function TIdSocketListVCLPosix.SelectRead(const ATimeout: Integer): Boolean;
  351. var
  352. LSet: fd_set;
  353. begin
  354. Lock;
  355. try
  356. LSet := FFDSet;
  357. // select() updates this structure on return,
  358. // so we need to copy it each time we need it
  359. finally
  360. Unlock;
  361. end;
  362. Result := FDSelect(@LSet, nil, nil, ATimeout) > 0;
  363. end;
  364. function TIdSocketListVCLPosix.SelectReadList(var VSocketList: TIdSocketList;
  365. const ATimeout: Integer): Boolean;
  366. var
  367. LSet: fd_set;
  368. begin
  369. Lock;
  370. try
  371. LSet := FFDSet;
  372. // select() updates this structure on return,
  373. // so we need to copy it each time we need it
  374. finally
  375. Unlock;
  376. end;
  377. Result := FDSelect(@LSet, nil, nil, ATimeout) > 0;
  378. if Result then begin
  379. if VSocketList = nil then begin
  380. VSocketList := TIdSocketList.CreateSocketList;
  381. end;
  382. TIdSocketListVCLPosix(VSocketList).SetFDSet(LSet);
  383. end;
  384. end;
  385. procedure TIdSocketListVCLPosix.SetFDSet(var VSet: fd_set);
  386. begin
  387. Lock;
  388. try
  389. FFDSet := VSet;
  390. finally
  391. Unlock;
  392. end;
  393. end;
  394. { TIdStackVCLPosix }
  395. {
  396. IMPORTANT!!!
  397. Throughout much of this code, you will see stuff such as:
  398. var
  399. LAddrStore: sockaddr_storage;
  400. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  401. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  402. LAddr : sockaddr absolute LAddrStore;
  403. This is just a fancy way to do typecasting with various types of address type.
  404. Many functions take a sockaddr parameter but that parameter is typecast for various
  405. address types. The structures mentioned above are designed just for such
  406. typecasting. The reason we use sockaddr_storage instead of sockaddr is that
  407. we need something that is guaranteed to be able to contain various address types
  408. and sockaddr would be too short for some of them and we can't know what
  409. someone else will add to Indy as time goes by.
  410. }
  411. function TIdStackVCLPosix.Accept(ASocket: TIdStackSocketHandle; var VIP: string;
  412. var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle;
  413. var
  414. LN: socklen_t;
  415. LAddrStore: sockaddr_storage;
  416. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  417. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  418. LAddr : sockaddr absolute LAddrStore;
  419. begin
  420. LN := SizeOf(LAddrStore);
  421. Result := Posix.SysSocket.accept(ASocket, LAddr, LN);
  422. if Result <> -1 then begin
  423. {$IFDEF HAS_SOCKET_NOSIGPIPE}
  424. SetSocketOption(Result, SOL_SOCKET, SO_NOSIGPIPE, 1);
  425. {$ENDIF}
  426. case LAddrStore.ss_family of
  427. Id_PF_INET4: begin
  428. VIP := TranslateTInAddrToString( LAddrIPv4.sin_addr, Id_IPv4);
  429. VPort := ntohs(LAddrIPv4.sin_port);
  430. VIPVersion := Id_IPV4;
  431. end;
  432. Id_PF_INET6: begin
  433. VIP := TranslateTInAddrToString(LAddrIPv6.sin6_addr, Id_IPv6);
  434. VPort := ntohs(LAddrIPv6.sin6_port);
  435. VIPVersion := Id_IPV6;
  436. end
  437. else begin
  438. __close(Result);
  439. Result := Id_INVALID_SOCKET;
  440. IPVersionUnsupported;
  441. end;
  442. end;
  443. end else begin
  444. if GetLastError = EBADF then begin
  445. SetLastError(EINTR);
  446. end;
  447. end;
  448. end;
  449. {$IFDEF HAS_getifaddrs}
  450. function getifaddrs(var ifap: pifaddrs): Integer; cdecl; external libc name _PU + 'getifaddrs'; {do not localize}
  451. procedure freeifaddrs(ifap: pifaddrs); cdecl; external libc name _PU + 'freeifaddrs'; {do not localize}
  452. {$IFDEF HAS_if_nametoindex}
  453. function if_nametoindex(const ifname: PIdAnsiChar): UInt32; cdecl; external libc name _PU + 'if_nametoindex'; {do not localize}
  454. {$ENDIF}
  455. type
  456. TIdStackLocalAddressAccess = class(TIdStackLocalAddress)
  457. end;
  458. {$ELSE}
  459. {$IFDEF ANDROID}
  460. // IdIfAddrs.pas has a getifaddrs() implementation ported from code at https://github.com/morristech/android-ifaddrs
  461. {.$DEFINE HAS_getifaddrs}
  462. {$ENDIF}
  463. {$ENDIF}
  464. procedure TIdStackVCLPosix.GetLocalAddressList(AAddresses: TIdStackLocalAddressList);
  465. var
  466. {$IFDEF HAS_getifaddrs}
  467. LAddrList, LAddrInfo: pifaddrs;
  468. LSubNetStr, LBroadcastStr: String;
  469. LAddress: TIdStackLocalAddress;
  470. LName: string;
  471. {$ELSE}
  472. LRetVal: Integer;
  473. LHostName: string;
  474. Hints: AddrInfo;
  475. LAddrList, LAddrInfo: pAddrInfo;
  476. {$IFDEF USE_MARSHALLED_PTRS}
  477. M: TMarshaller;
  478. {$ENDIF}
  479. {$ENDIF}
  480. begin
  481. // TODO: Using gethostname() and getaddrinfo() like this may not always return just
  482. // the machine's IP addresses. Technically speaking, they will return the local
  483. // hostname, and then return the address(es) to which that hostname resolves.
  484. // It is possible for a machine to (a) be configured such that its name does
  485. // not resolve to an IP, or (b) be configured such that its name resolves to
  486. // multiple IPs, only one of which belongs to the local machine. For better
  487. // results, we should use getifaddrs() on platforms that support it...
  488. {$IFDEF HAS_getifaddrs}
  489. if getifaddrs(LAddrList) = 0 then // TODO: raise an exception if it fails
  490. try
  491. AAddresses.BeginUpdate;
  492. try
  493. LAddrInfo := LAddrList;
  494. repeat
  495. if (LAddrInfo^.ifa_addr <> nil) and ((LAddrInfo^.ifa_flags and IFF_LOOPBACK) = 0) then
  496. begin
  497. LAddress := nil;
  498. case LAddrInfo^.ifa_addr^.sa_family of
  499. Id_PF_INET4: begin
  500. if LAddrInfo^.ifa_netmask <> nil then begin
  501. LSubNetStr := TranslateTInAddrToString( PSockAddr_In(LAddrInfo^.ifa_netmask)^.sin_addr, Id_IPv4);
  502. end else begin
  503. LSubNetStr := '';
  504. end;
  505. if ((LAddrInfo^.ifa_flags and IFF_BROADCAST) <> 0) and (LAddrInfo^.ifa_broadaddr <> nil) then
  506. LBroadcastStr := TranslateTInAddrToString( PSockAddr_In(LAddrInfo^.ifa_broadaddr)^.sin_addr, Id_IPv4);
  507. end else begin
  508. LBroadcastStr := '';
  509. end;
  510. LAddress := TIdStackLocalAddressIPv4.Create(AAddresses, TranslateTInAddrToString( PSockAddr_In(LAddrInfo^.ifa_addr)^.sin_addr, Id_IPv4), LSubNetStr, LBroadcastStr);
  511. end;
  512. Id_PF_INET6: begin
  513. LAddress := TIdStackLocalAddressIPv6.Create(AAddresses, TranslateTInAddrToString( PSockAddr_In6(LAddrInfo^.ifa_addr)^.sin6_addr, Id_IPv6));
  514. end;
  515. end;
  516. if LAddress <> nil then begin
  517. LName := String(LAddrInfo^.ifa_name);
  518. {$I IdObjectChecksOff.inc}
  519. TIdStackLocalAddressAccess(LAddress).FDescription := LName;
  520. TIdStackLocalAddressAccess(LAddress).FFriendlyName := LName;
  521. TIdStackLocalAddressAccess(LAddress).FInterfaceName := LName;
  522. {$IFDEF HAS_if_nametoindex}
  523. TIdStackLocalAddressAccess(LAddress).FInterfaceIndex := if_nametoindex(LAddrInfo^.ifa_name);
  524. {$ENDIF}
  525. {$I IdObjectChecksOn.inc}
  526. end;
  527. end;
  528. LAddrInfo := LAddrInfo^.ifa_next;
  529. until LAddrInfo = nil;
  530. // TODO: sort AAddresses by IPVersion...
  531. finally
  532. AAddresses.EndUpdate;
  533. end;
  534. finally
  535. freeifaddrs(LAddrList);
  536. end;
  537. {$ELSE}
  538. // TODO: on Android, either implement getifaddrs() (https://github.com/morristech/android-ifaddrs)
  539. // or use the Java API to enumerate the local network interfaces and their IP addresses, eg:
  540. {
  541. Note that the following requires the application to have ACCESS_NETWORK_STATE and INTERNET permissions.
  542. uses
  543. Androidapi.JNI.Java.Net,
  544. Androidapi.JNI.JavaTypes,
  545. Androidapi.JNIBridge,
  546. ($IFDEF VCL_XE7_OR_ABOVE)
  547. Androidapi.Helpers
  548. ($ELSE)
  549. FMX.Helpers.Android
  550. ($ENDIF)
  551. ;
  552. var
  553. LInterfaces: JEnumeration;
  554. LInterface: JNetworkInterface;
  555. LAddresses: JList;
  556. LInterfaceAddress: JInterfaceAddress;
  557. LAddress: JInetAddress;
  558. LName, LHostAddress, LBroadcastAddress: string;
  559. I, LPos: Integer;
  560. function PrefixLengthToString(PrefixLength: Int16): String;
  561. var
  562. LMask: UInt32;
  563. begin
  564. if (PrefixLength > 0) and (PrefixLength < 32) then begin
  565. LMask := $FFFFFFFF shl (32 - PrefixLength);
  566. Result := Format('%d.%d.%d.%d', [(LMask shr 24) and $FF, (LMask shr 16) and $FF, (LMask shr 8) and $FF, LMask and $FF]);
  567. end else begin
  568. Result := '';
  569. end;
  570. end;
  571. begin
  572. try
  573. LInterfaces := TJNetworkInterface.JavaClass.getNetworkInterfaces;
  574. if LInterfaces.hasMoreElements then
  575. begin
  576. AAddresses.BeginUpdate;
  577. try
  578. repeat
  579. LInterface := TJNetworkInterface.Wrap(JObjectToID(LInterfaces.nextElement));
  580. LAddresses := LInterface.getInterfaceAddresses;
  581. if LAddresses = nil then begin
  582. Continue;
  583. end;
  584. for I := 0 to LAddresses.size - 1 do
  585. begin
  586. LInterfaceAddress := TJInterfaceAddress.Wrap(JObjectToID(LAddresses.get(I)));
  587. LAddress := LInterfaceAddress.getAddress;
  588. if LAddress.isLoopbackAddress then begin
  589. Continue;
  590. end;
  591. LHostAddress := JStringToString(LAddress.getHostAddress);
  592. // Trim excess stuff
  593. LPos := Pos('%', LHostAddress);
  594. if LPos <> 0 then begin
  595. LHostAddress := Copy(LHostAddress, 1, LPos-1);
  596. end;
  597. // Hack until I can find out how to check properly
  598. //if (LAddress instanceof Inet4Address) then begin
  599. LName := JStringToString(LAddress.getClass.getName);
  600. if Pos('Inet4Address', LName) <> 0 then begin
  601. // NOTE: java.lang.System.setProperty("java.net.preferIPv4Stack", "true") needs to be called
  602. // before NetworkInterface.getNetworkInterfaces() is called for the first time or else the
  603. // InterfaceAddress.getBroadcast() method will not work reliably for IPv4 on systems with an
  604. // IPv6 stack installed, it will usually just report 255.255.255.255 instead (see
  605. // https://enigma2eureka.blogspot.com/2009/08/finding-your-ip-v4-broadcast-address.html)...
  606. LAddress := LAddress.getBroadcast;
  607. if LAddress <> nil then begin
  608. LBroadcastAddress := JStringToString(LAddress.getHostAddress);
  609. // Trim excess stuff
  610. LPos := Pos('%', LBroadcastAddress);
  611. if LPos <> 0 then begin
  612. LBroadcastAddress := Copy(LBroadcastAddress, 1, LPos-1);
  613. end;
  614. end else begin
  615. LBroadcastAddress := '';
  616. end;
  617. TIdStackLocalAddressIPv4.Create(AAddresses, LHostAddress, PrefixLengthToString(LAddress.getNetworkPrefixLength), LBroadcastAddress);
  618. end
  619. // else if (LAddress instanceof Inet6Address) then begin
  620. else if Pos('Inet6Address', LName) <> 0 then begin
  621. TIdStackLocalAddressIPv6.Create(AAddresses, LHostAddress);
  622. end;
  623. end;
  624. until not LInterfaces.hasMoreElements;
  625. finally
  626. AAddresses.EndUpdate;
  627. end;
  628. end;
  629. except
  630. if not HasAndroidPermission('android.permission.ACCESS_NETWORK_STATE') then begin
  631. IndyRaiseOuterException(EIdAccessNetworkStatePermissionNeeded.CreateError(0, ''));
  632. end;
  633. if not HasAndroidPermission('android.permission.INTERNET') then begin
  634. IndyRaiseOuterException(EIdInternetPermissionNeeded.CreateError(0, ''));
  635. end;
  636. raise;
  637. end;
  638. end;
  639. Or the following, which requires only ACCESS_WIFI_STATE permission.
  640. uses
  641. if XE7+
  642. Androidapi.Helpers
  643. else
  644. FMX.Helpers.Android
  645. ;
  646. var
  647. wifiManager: JWifiManager;
  648. dhcp: JDhcpInfo;
  649. ipAddress, netMask, bcAddress: Integer;
  650. function IntToIPv4Str(Addr: Integer): String;
  651. begin
  652. Result := Format('%d.%d.%d.%d', [Addr and $FF, (Addr shr 8) and $FF, (Addr shr 16) and $FF, (Addr shr 24) and $FF]),
  653. end;
  654. begin
  655. // WiFiInfo and DhcoInfo only support IPv4
  656. try
  657. wifiManager := TJWifiManager.Wrap(JObjectToID(SharedActivityContext.getSystemService(TJContext.JavaClass.WIFI_SERVICE)));
  658. dhcp := wifiManager.getDhcpInfo;
  659. if dhcp = nil then begin
  660. Exit;
  661. end;
  662. ipAddress := dhcp.getIpAddress;
  663. netMask := dhcp.getNetMask;
  664. bcAddress := (ipAddress and netMask) or (not netMask);
  665. except
  666. if not HasAndroidPermission('android.permission.ACCESS_WIFI_STATE') then begin
  667. IndyRaiseOuterException(EIdAccessWifiStatePermissionNeeded.CreateError(0, ''));
  668. end else begin
  669. raise;
  670. end;
  671. end;
  672. TIdStackLocalAddressIPv4.Create(AAddresses, IntToIPv4Str(ipAddress), IntToIPv4Str(netMask), IntToIPv4Str(bcAddress));
  673. end;
  674. }
  675. //IMPORTANT!!!
  676. //
  677. //The Hints structure must be zeroed out or you might get an AV.
  678. //I've seen this in Mac OS X
  679. FillChar(Hints, SizeOf(Hints), 0);
  680. Hints.ai_family := PF_UNSPEC; // returns both IPv4 and IPv6 addresses
  681. Hints.ai_socktype := SOCK_STREAM;
  682. LHostName := HostName;
  683. LRetVal := getaddrinfo(
  684. {$IFDEF USE_MARSHALLED_PTRS}
  685. M.AsAnsi(LHostName).ToPointer
  686. {$ELSE}
  687. PAnsiChar(AnsiString(LHostName)) // explicit convert to Ansi
  688. {$ENDIF},
  689. nil, Hints, LAddrList);
  690. if LRetVal <> 0 then begin
  691. if LRetVal = EAI_SYSTEM then begin
  692. RaiseLastOSError;
  693. end else begin
  694. raise EIdReverseResolveError.CreateFmt(RSReverseResolveError, [LHostName, gai_strerror(LRetVal), LRetVal]);
  695. end;
  696. end;
  697. try
  698. AAddresses.BeginUpdate;
  699. try
  700. LAddrInfo := LAddrList;
  701. repeat
  702. case LAddrInfo^.ai_family of
  703. Id_PF_INET4 :
  704. begin
  705. TIdStackLocalAddressIPv4.Create(AAddresses, TranslateTInAddrToString( PSockAddr_In(LAddrInfo^.ai_addr)^.sin_addr, Id_IPv4), '', ''); // TODO: SubNetMask and BroadcastIP
  706. end;
  707. Id_PF_INET6 :
  708. begin
  709. TIdStackLocalAddressIPv6.Create(AAddresses, TranslateTInAddrToString( PSockAddr_In6(LAddrInfo^.ai_addr)^.sin6_addr, Id_IPv6));
  710. end;
  711. end;
  712. LAddrInfo := LAddrInfo^.ai_next;
  713. until LAddrInfo = nil;
  714. finally
  715. AAddresses.EndUpdate;
  716. end;
  717. finally
  718. freeaddrinfo(LAddrList^);
  719. end;
  720. {$ENDIF}
  721. end;
  722. procedure TIdStackVCLPosix.Bind(ASocket: TIdStackSocketHandle;
  723. const AIP: string; const APort: TIdPort; const AIPVersion: TIdIPVersion);
  724. var
  725. LAddrStore: sockaddr_storage;
  726. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  727. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  728. LAddr : sockaddr absolute LAddrStore;
  729. begin
  730. case AIPVersion of
  731. Id_IPv4: begin
  732. InitSockAddr_In(LAddrIPv4);
  733. if AIP <> '' then begin
  734. TranslateStringToTInAddr(AIP, LAddrIPv4.sin_addr, Id_IPv4);
  735. end;
  736. LAddrIPv4.sin_port := htons(APort);
  737. CheckForSocketError(Posix.SysSocket.bind(ASocket, LAddr, SizeOf(LAddrIPv4)));
  738. end;
  739. Id_IPv6: begin
  740. InitSockAddr_in6(LAddrIPv6);
  741. if AIP <> '' then begin
  742. TranslateStringToTInAddr(AIP, LAddrIPv6.sin6_addr, Id_IPv6);
  743. end;
  744. LAddrIPv6.sin6_port := htons(APort);
  745. CheckForSocketError(Posix.SysSocket.bind(ASocket,LAddr, SizeOf(LAddrIPv6)));
  746. end;
  747. else begin
  748. IPVersionUnsupported;
  749. end;
  750. end;
  751. end;
  752. function TIdStackVCLPosix.CheckIPVersionSupport(
  753. const AIPVersion: TIdIPVersion): boolean;
  754. var
  755. LTmpSocket: TIdStackSocketHandle;
  756. begin
  757. // TODO: on nix systems (or maybe just Linux?), an alternative would be to
  758. // check for the existance of the '/proc/net/if_inet6' kernel pseudo-file
  759. LTmpSocket := WSSocket(IdIPFamily[AIPVersion], Id_SOCK_STREAM, Id_IPPROTO_IP );
  760. Result := LTmpSocket <> Id_INVALID_SOCKET;
  761. if Result then begin
  762. WSCloseSocket(LTmpSocket);
  763. end;
  764. end;
  765. procedure TIdStackVCLPosix.Connect(const ASocket: TIdStackSocketHandle;
  766. const AIP: string; const APort: TIdPort; const AIPVersion: TIdIPVersion);
  767. var
  768. LAddrStore: sockaddr_storage;
  769. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  770. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  771. LAddr : sockaddr absolute LAddrStore;
  772. begin
  773. case AIPVersion of
  774. Id_IPv4: begin
  775. InitSockAddr_In(LAddrIPv4);
  776. TranslateStringToTInAddr(AIP, LAddrIPv4.sin_addr, Id_IPv4);
  777. LAddrIPv4.sin_port := htons(APort);
  778. CheckForSocketError(Posix.SysSocket.connect(ASocket, LAddr, SizeOf(LAddrIPv4)));
  779. end;
  780. Id_IPv6: begin
  781. InitSockAddr_in6(LAddrIPv6);
  782. TranslateStringToTInAddr(AIP, LAddrIPv6.sin6_addr, Id_IPv6);
  783. LAddrIPv6.sin6_port := htons(APort);
  784. CheckForSocketError(Posix.SysSocket.connect(ASocket, LAddr, SizeOf(LAddrIPv6)));
  785. end;
  786. else begin
  787. IPVersionUnsupported;
  788. end;
  789. end;
  790. end;
  791. constructor TIdStackVCLPosix.Create;
  792. begin
  793. inherited Create;
  794. end;
  795. destructor TIdStackVCLPosix.Destroy;
  796. begin
  797. inherited Destroy;
  798. end;
  799. procedure TIdStackVCLPosix.Disconnect(ASocket: TIdStackSocketHandle);
  800. begin
  801. // Windows uses Id_SD_Send, Linux should use Id_SD_Both
  802. WSShutdown(ASocket, Id_SD_Both);
  803. // SO_LINGER is false - socket may take a little while to actually close after this
  804. WSCloseSocket(ASocket);
  805. end;
  806. function TIdStackVCLPosix.GetLastError: Integer;
  807. begin
  808. Result := errno;
  809. end;
  810. procedure TIdStackVCLPosix.GetPeerName(ASocket: TIdStackSocketHandle;
  811. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion);
  812. var
  813. i: socklen_t;
  814. LAddrStore: sockaddr_storage;
  815. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  816. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  817. LAddr : sockaddr absolute LAddrStore;
  818. begin
  819. i := SizeOf(LAddrStore);
  820. CheckForSocketError(Posix.SysSocket.getpeername(ASocket, LAddr, i));
  821. case LAddrStore.ss_family of
  822. Id_PF_INET4: begin
  823. VIP := TranslateTInAddrToString(LAddrIPv4.sin_addr, Id_IPv4);
  824. VPort := ntohs(LAddrIPv4.sin_port);
  825. VIPVersion := Id_IPV4;
  826. end;
  827. Id_PF_INET6: begin
  828. VIP := TranslateTInAddrToString(LAddrIPv6.sin6_addr, Id_IPv6);
  829. VPort := ntohs(LAddrIPv6.sin6_port);
  830. VIPVersion := Id_IPV6;
  831. end;
  832. else begin
  833. IPVersionUnsupported;
  834. end;
  835. end;
  836. end;
  837. procedure TIdStackVCLPosix.GetSocketName(ASocket: TIdStackSocketHandle;
  838. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion);
  839. var
  840. LiSize: socklen_t;
  841. LAddrStore: sockaddr_storage;
  842. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  843. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  844. LAddr : sockaddr absolute LAddrStore;
  845. begin
  846. LiSize := SizeOf(LAddrStore);
  847. CheckForSocketError(getsockname(ASocket, LAddr, LiSize));
  848. case LAddrStore.ss_family of
  849. Id_PF_INET4: begin
  850. VIP := TranslateTInAddrToString(LAddrIPv4.sin_addr, Id_IPv4);
  851. VPort := ntohs(LAddrIPv4.sin_port);
  852. VIPVersion := Id_IPV4;
  853. end;
  854. Id_PF_INET6: begin
  855. VIP := TranslateTInAddrToString(LAddrIPv6.sin6_addr, Id_IPv6);
  856. VPort := ntohs(LAddrIPv6.sin6_port);
  857. VIPVersion := Id_IPV6;
  858. end;
  859. else begin
  860. IPVersionUnsupported;
  861. end;
  862. end;
  863. end;
  864. function TIdStackVCLPosix.HostByAddress(const AAddress: string;
  865. const AIPVersion: TIdIPVersion): string;
  866. var
  867. LiSize: socklen_t;
  868. LAddrStore: sockaddr_storage;
  869. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  870. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  871. LAddr : sockaddr absolute LAddrStore;
  872. LHostName : array[0..NI_MAXHOST] of TIdAnsiChar;
  873. {$IFDEF USE_MARSHALLED_PTRS}
  874. LHostNamePtr: TPtrWrapper;
  875. {$ENDIF}
  876. LRet : Integer;
  877. LHints : addrinfo;
  878. LAddrInfo: pAddrInfo;
  879. begin
  880. LiSize := 0;
  881. case AIPVersion of
  882. Id_IPv4 :
  883. begin
  884. InitSockAddr_In(LAddrIPv4);
  885. TranslateStringToTInAddr(AAddress,LAddrIPv4.sin_addr,Id_IPv4);
  886. LiSize := SizeOf(SockAddr_In);
  887. end;
  888. Id_IPv6 :
  889. begin
  890. InitSockAddr_In6(LAddrIPv6);
  891. TranslateStringToTInAddr(AAddress,LAddrIPv6.sin6_addr,Id_IPv6);
  892. LiSize := SizeOf(SockAddr_In6);
  893. end
  894. else
  895. IPVersionUnsupported;
  896. end;
  897. FillChar(LHostName[0],Length(LHostName),0);
  898. {$IFDEF USE_MARSHALLED_PTRS}
  899. LHostNamePtr := TPtrWrapper.Create(@LHostName[0]);
  900. {$ENDIF}
  901. LRet := getnameinfo(LAddr,LiSize,
  902. {$IFDEF USE_MARSHALLED_PTRS}
  903. LHostNamePtr.ToPointer
  904. {$ELSE}
  905. LHostName
  906. {$ENDIF},
  907. NI_MAXHOST,nil,0,NI_NAMEREQD );
  908. if LRet <> 0 then begin
  909. if LRet = EAI_SYSTEM then begin
  910. RaiseLastOSError;
  911. end else begin
  912. raise EIdReverseResolveError.CreateFmt(RSReverseResolveError, [AAddress, gai_strerror(LRet), LRet]);
  913. end;
  914. end;
  915. {
  916. IMPORTANT!!!
  917. getnameinfo can return either results from a numeric to text conversion or
  918. results from a DNS reverse lookup. Someone could make a malicous PTR record
  919. such as
  920. 1.0.0.127.in-addr.arpa. IN PTR 10.1.1.1
  921. and trick a caller into beleiving the socket address is 10.1.1.1 instead of
  922. 127.0.0.1. If there is a numeric host in LAddr, than this is the case and
  923. we disregard the result and raise an exception.
  924. }
  925. FillChar(LHints, SizeOf(LHints), 0);
  926. LHints.ai_socktype := SOCK_DGRAM; //*dummy*/
  927. LHints.ai_flags := AI_NUMERICHOST;
  928. if getaddrinfo(
  929. {$IFDEF USE_MARSHALLED_PTRS}
  930. LHostNamePtr.ToPointer
  931. {$ELSE}
  932. LHostName
  933. {$ENDIF},
  934. '0', LHints, LAddrInfo) = 0 then
  935. begin
  936. freeaddrinfo(LAddrInfo^);
  937. Result := '';
  938. raise EIdMaliciousPtrRecord.Create(RSMaliciousPtrRecord);
  939. end;
  940. {$IFDEF USE_MARSHALLED_PTRS}
  941. Result := TMarshal.ReadStringAsAnsi(LHostNamePtr);
  942. {$ELSE}
  943. Result := String(LHostName);
  944. {$ENDIF}
  945. end;
  946. function TIdStackVCLPosix.HostByName(const AHostName: string;
  947. const AIPVersion: TIdIPVersion): string;
  948. var
  949. LAddrInfo: pAddrInfo;
  950. LHints: AddrInfo;
  951. LRetVal: Integer;
  952. {$IFDEF USE_MARSHALLED_PTRS}
  953. M: TMarshaller;
  954. {$ENDIF}
  955. begin
  956. if not (AIPVersion in [Id_IPv4, Id_IPv6]) then begin
  957. IPVersionUnsupported;
  958. end;
  959. //IMPORTANT!!!
  960. //
  961. //The Hints structure must be zeroed out or you might get an AV.
  962. //I've seen this in Mac OS X
  963. FillChar(LHints, SizeOf(LHints), 0);
  964. LHints.ai_family := IdIPFamily[AIPVersion];
  965. LHints.ai_socktype := SOCK_STREAM;
  966. LAddrInfo := nil;
  967. LRetVal := getaddrinfo(
  968. {$IFDEF USE_MARSHALLED_PTRS}
  969. M.AsAnsi(AHostName).ToPointer
  970. {$ELSE}
  971. PAnsiChar(AnsiString(AHostName)) // explicit convert to Ansi
  972. {$ENDIF},
  973. nil, LHints, LAddrInfo);
  974. if LRetVal <> 0 then begin
  975. if LRetVal = EAI_SYSTEM then begin
  976. RaiseLastOSError;
  977. end else begin
  978. raise EIdResolveError.CreateFmt(RSReverseResolveError, [AHostName, gai_strerror(LRetVal), LRetVal]);
  979. end;
  980. end;
  981. try
  982. if AIPVersion = Id_IPv4 then begin
  983. Result := TranslateTInAddrToString( PSockAddr_In( LAddrInfo^.ai_addr)^.sin_addr, AIPVersion);
  984. end else begin
  985. Result := TranslateTInAddrToString( PSockAddr_In6( LAddrInfo^.ai_addr)^.sin6_addr, AIPVersion);
  986. end;
  987. finally
  988. freeaddrinfo(LAddrInfo^);
  989. end;
  990. end;
  991. function TIdStackVCLPosix.HostToNetwork(AValue: UInt32): UInt32;
  992. begin
  993. Result := htonl(AValue);
  994. end;
  995. function TIdStackVCLPosix.HostToNetwork(AValue: UInt16): UInt16;
  996. begin
  997. Result := htons(AValue);
  998. end;
  999. function TIdStackVCLPosix.HostToNetwork(AValue: UInt64): UInt64;
  1000. var
  1001. LParts: TIdUInt64Parts;//TIdUInt64Words
  1002. L: UInt32;
  1003. begin
  1004. // TODO: enable this?
  1005. {
  1006. LParts.LongWords[0] := htonl(UInt32(AValue shr 32));
  1007. LParts.LongWords[1] := htonl(UInt32(AValue));
  1008. Result := LParts.QuadPart;
  1009. }
  1010. if (htonl(1) <> 1) then begin
  1011. LParts.QuadPart := AValue;
  1012. L := htonl(LParts.HighPart);
  1013. LParts.HighPart := htonl(LParts.LowPart);
  1014. LParts.LowPart := L;
  1015. Result := LParts.QuadPart;
  1016. end else begin
  1017. Result := AValue;
  1018. end;
  1019. end;
  1020. function TIdStackVCLPosix.IOControl(const s: TIdStackSocketHandle;
  1021. const cmd: UInt32; var arg: UInt32): Integer;
  1022. begin
  1023. Result := ioctl(s, cmd, @arg);
  1024. end;
  1025. procedure TIdStackVCLPosix.Listen(ASocket: TIdStackSocketHandle;
  1026. ABackLog: Integer);
  1027. begin
  1028. CheckForSocketError(Posix.SysSocket.listen(ASocket, ABacklog));
  1029. end;
  1030. function TIdStackVCLPosix.NetworkToHost(AValue: UInt32): UInt32;
  1031. begin
  1032. Result := ntohl(AValue);
  1033. end;
  1034. function TIdStackVCLPosix.NetworkToHost(AValue: UInt64): UInt64;
  1035. var
  1036. LParts: TIdUInt64Parts;//TIdUInt64Words
  1037. L: UInt32;
  1038. begin
  1039. // TODO: enable this?
  1040. {
  1041. LParts.QuadPart := AValue;
  1042. Result := (UInt64(ntohl(LParts.LongWords[0])) shl 32) or UInt64(ntohl(LParts.LongWords[1]));
  1043. }
  1044. if (ntohl(1) <> 1) then begin
  1045. LParts.QuadPart := AValue;
  1046. L := ntohl(LParts.HighPart);
  1047. LParts.HighPart := ntohl(LParts.LowPart);
  1048. LParts.LowPart := L;
  1049. Result := LParts.QuadPart;
  1050. end else begin
  1051. Result := AValue;
  1052. end;
  1053. end;
  1054. function TIdStackVCLPosix.NetworkToHost(AValue: UInt16): UInt16;
  1055. begin
  1056. Result := ntohs(AValue);
  1057. end;
  1058. function TIdStackVCLPosix.ReadHostName: string;
  1059. const
  1060. sMaxHostSize = 250;
  1061. var
  1062. LStr: array[0..sMaxHostSize] of TIdAnsiChar;
  1063. {$IFDEF USE_MARSHALLED_PTRS}
  1064. LStrPtr: TPtrWrapper;
  1065. {$ENDIF}
  1066. begin
  1067. {$IFDEF USE_MARSHALLED_PTRS}
  1068. LStrPtr := TPtrWrapper.Create(@LStr[0]);
  1069. {$ENDIF}
  1070. if gethostname(
  1071. {$IFDEF USE_MARSHALLED_PTRS}
  1072. LStrPtr.ToPointer
  1073. {$ELSE}
  1074. LStr
  1075. {$ENDIF}, sMaxHostSize) = 0 then
  1076. begin
  1077. {$IFDEF USE_MARSHALLED_PTRS}
  1078. Result := TMarshal.ReadStringAsAnsiUpTo(0, LStrPtr, sMaxHostSize);
  1079. {$ELSE}
  1080. LStr[sMaxHostSize] := TIdAnsiChar(0);
  1081. Result := String(LStr);
  1082. {$ENDIF}
  1083. end else begin
  1084. Result := '';
  1085. end;
  1086. end;
  1087. function TIdStackVCLPosix.ReceiveMsg(ASocket: TIdStackSocketHandle;
  1088. var VBuffer: TIdBytes; APkt: TIdPacketInfo): UInt32;
  1089. var
  1090. LSize: socklen_t;
  1091. LAddrStore: sockaddr_storage;
  1092. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  1093. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  1094. LAddr : sockaddr absolute LAddrStore;
  1095. LMsg : msghdr;
  1096. LIOV : iovec;
  1097. LControl : TIdBytes;
  1098. LCurCmsg : Pcmsghdr; //for iterating through the control buffer
  1099. LByte : PByte;
  1100. begin
  1101. //we call the macro twice because we specified two possible structures.
  1102. //Id_IPV6_HOPLIMIT and Id_IPV6_PKTINFO
  1103. LSize := CMSG_LEN(CMSG_LEN(Length(VBuffer)));
  1104. SetLength( LControl,LSize);
  1105. LIOV.iov_len := Length(VBuffer); // Length(VMsgData);
  1106. LIOV.iov_base := @VBuffer[0]; // @VMsgData[0];
  1107. FillChar(LMsg,SizeOf(LMsg),0);
  1108. LMsg.msg_iov := @LIOV;//lpBuffers := @LMsgBuf;
  1109. LMsg.msg_iovlen := 1;
  1110. LMsg.msg_controllen := LSize;
  1111. LMsg.msg_control := @LControl[0];
  1112. LMsg.msg_name := @LAddr;
  1113. LMsg.msg_namelen := SizeOf(LAddrStore);
  1114. Result := 0;
  1115. CheckForSocketError(RecvMsg(ASocket, LMsg, Result));
  1116. APkt.Reset;
  1117. case LAddrStore.ss_family of
  1118. Id_PF_INET4: begin
  1119. APkt.SourceIP := TranslateTInAddrToString(LAddrIPv4.sin_addr, Id_IPv4);
  1120. APkt.SourcePort := ntohs(LAddrIPv4.sin_port);
  1121. APkt.SourceIPVersion := Id_IPv4;
  1122. end;
  1123. Id_PF_INET6: begin
  1124. APkt.SourceIP := TranslateTInAddrToString(LAddrIPv6.sin6_addr, Id_IPv6);
  1125. APkt.SourcePort := ntohs(LAddrIPv6.sin6_port);
  1126. APkt.SourceIPVersion := Id_IPv6;
  1127. end;
  1128. else begin
  1129. Result := 0; // avoid warning
  1130. IPVersionUnsupported;
  1131. end;
  1132. end;
  1133. LCurCmsg := nil;
  1134. repeat
  1135. LCurCmsg := CMSG_NXTHDR(@LMsg, LCurCmsg);
  1136. if LCurCmsg = nil then begin
  1137. break;
  1138. end;
  1139. case LCurCmsg^.cmsg_type of
  1140. IPV6_PKTINFO : //done this way because IPV6_PKTINF and IP_PKTINFO are both 19
  1141. begin
  1142. case LAddrStore.ss_family of
  1143. Id_PF_INET4: begin
  1144. {$IFDEF IOS}
  1145. ToDo('PKTINFO not implemented for IPv4 under iOS yet');
  1146. {$ELSE}
  1147. {$IFNDEF OSX}
  1148. //This is not supported in OS X.
  1149. with Pin_pktinfo(CMSG_DATA(LCurCmsg))^ do begin
  1150. APkt.DestIP := TranslateTInAddrToString(ipi_addr, Id_IPv4);
  1151. APkt.DestIF := ipi_ifindex;
  1152. end;
  1153. APkt.DestIPVersion := Id_IPv4;
  1154. {$ENDIF}
  1155. {$ENDIF}
  1156. end;
  1157. Id_PF_INET6: begin
  1158. with pin6_pktinfo(CMSG_DATA(LCurCmsg))^ do begin
  1159. APkt.DestIP := TranslateTInAddrToString(ipi6_addr, Id_IPv6);
  1160. APkt.DestIF := ipi6_ifindex;
  1161. end;
  1162. APkt.DestIPVersion := Id_IPv6;
  1163. end;
  1164. end;
  1165. end;
  1166. Id_IPV6_HOPLIMIT :
  1167. begin
  1168. LByte := PByte(CMSG_DATA(LCurCmsg));
  1169. APkt.TTL := LByte^;
  1170. end;
  1171. end;
  1172. until False;
  1173. end;
  1174. function TIdStackVCLPosix.RecvFrom(const ASocket: TIdStackSocketHandle;
  1175. var VBuffer; const ALength, AFlags: Integer; var VIP: string;
  1176. var VPort: TIdPort; var VIPVersion: TIdIPVersion): Integer;
  1177. var
  1178. LiSize: socklen_t;
  1179. LAddrStore: sockaddr_storage;
  1180. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  1181. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  1182. LAddr : sockaddr absolute LAddrStore;
  1183. begin
  1184. LiSize := SizeOf(LAddrStore);
  1185. // TODO: only include MSG_NOSIGNAL if SO_NOSIGPIPE is not enabled?
  1186. Result := Posix.SysSocket.recvfrom(ASocket,VBuffer, ALength, AFlags or Id_MSG_NOSIGNAL, LAddr, LiSize);
  1187. if Result >= 0 then
  1188. begin
  1189. case LAddrStore.ss_family of
  1190. Id_PF_INET4: begin
  1191. VIP := TranslateTInAddrToString(LAddrIPv4.sin_addr, Id_IPv4);
  1192. VPort := ntohs(LAddrIPv4.sin_port);
  1193. VIPVersion := Id_IPV4;
  1194. end;
  1195. Id_PF_INET6: begin
  1196. VIP := TranslateTInAddrToString(LAddrIPv6.sin6_addr, Id_IPv6);
  1197. VPort := ntohs(LAddrIPv6.sin6_port);
  1198. VIPVersion := Id_IPV6;
  1199. end;
  1200. else begin
  1201. Result := 0;
  1202. IPVersionUnsupported;
  1203. end;
  1204. end;
  1205. end;
  1206. end;
  1207. procedure TIdStackVCLPosix.SetBlocking(ASocket: TIdStackSocketHandle;
  1208. const ABlocking: Boolean);
  1209. var
  1210. LFlags: Integer;
  1211. begin
  1212. LFlags := CheckForSocketError(fcntl(ASocket, F_GETFL, 0));
  1213. if ABlocking then begin
  1214. LFlags := LFlags and not O_NONBLOCK;
  1215. end else begin
  1216. LFlags := LFlags or O_NONBLOCK;
  1217. end;
  1218. CheckForSocketError(fcntl(ASocket, F_SETFL, LFlags));
  1219. end;
  1220. procedure TIdStackVCLPosix.SetLastError(const AError: Integer);
  1221. begin
  1222. __error^ := AError;
  1223. end;
  1224. procedure TIdStackVCLPosix.{$IFDEF DCC_XE3_OR_ABOVE}GetSocketOption{$ELSE}WSGetSocketOption{$ENDIF}
  1225. (ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption;
  1226. var AOptVal; var AOptLen: Integer);
  1227. var
  1228. LLen : socklen_t;
  1229. begin
  1230. LLen := AOptLen;
  1231. CheckForSocketError(Posix.SysSocket.getsockopt(ASocket, ALevel, AOptName, AOptVal, LLen));
  1232. AOptLen := LLen;
  1233. end;
  1234. procedure TIdStackVCLPosix.{$IFDEF DCC_XE3_OR_ABOVE}SetSocketOption{$ELSE}WSSetSocketOption{$ENDIF}
  1235. (ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption;
  1236. const AOptVal; const AOptLen: Integer);
  1237. begin
  1238. CheckForSocketError(Posix.SysSocket.setsockopt(ASocket, ALevel, AOptName, AOptVal, AOptLen));
  1239. end;
  1240. function TIdStackVCLPosix.SupportsIPv4: Boolean;
  1241. begin
  1242. {$IFDEF IOS}
  1243. // TODO: iOS 9+ is IPv6-only...
  1244. //Result := ([[[UIDevice currentDevice] systemVersion] compare:'9.0' options:NSNumericSearch] == NSOrderedAscending);
  1245. {$ENDIF}
  1246. //In Windows, this does something else. It checks the LSP's installed.
  1247. Result := CheckIPVersionSupport(Id_IPv4);
  1248. end;
  1249. function TIdStackVCLPosix.SupportsIPv6: Boolean;
  1250. begin
  1251. //In Windows, this does something else. It checks the LSP's installed.
  1252. Result := CheckIPVersionSupport(Id_IPv6);
  1253. end;
  1254. function TIdStackVCLPosix.WouldBlock(const AResult: Integer): Boolean;
  1255. begin
  1256. // using if-else instead of in..range because EAGAIN and EWOULDBLOCK
  1257. // have often the same value and so FPC might report a range error
  1258. Result := (AResult = Id_WSAEAGAIN) or
  1259. (AResult = Id_WSAEWOULDBLOCK) or
  1260. (AResult = Id_WSAEINPROGRESS);
  1261. end;
  1262. procedure TIdStackVCLPosix.WriteChecksum(s: TIdStackSocketHandle;
  1263. var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
  1264. const APort: TIdPort; const AIPVersion: TIdIPVersion);
  1265. begin
  1266. case AIPVersion of
  1267. Id_IPv4 : CopyTIdUInt16(HostToLittleEndian(CalcCheckSum(VBuffer)), VBuffer, AOffset);
  1268. Id_IPv6 : WriteChecksumIPv6(s, VBuffer, AOffset, AIP, APort);
  1269. else
  1270. IPVersionUnsupported;
  1271. end;
  1272. end;
  1273. procedure TIdStackVCLPosix.WriteChecksumIPv6(s: TIdStackSocketHandle;
  1274. var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
  1275. const APort: TIdPort);
  1276. begin
  1277. //we simply request that the kernal write the checksum when the data
  1278. //is sent. All of the parameters required are because Windows is bonked
  1279. //because it doesn't have the IPV6CHECKSUM socket option meaning we have
  1280. //to querry the network interface in TIdStackWindows -- yuck!!
  1281. SetSocketOption(s, Id_IPPROTO_IPV6, IPV6_CHECKSUM, AOffset);
  1282. end;
  1283. function TIdStackVCLPosix.WSCloseSocket(ASocket: TIdStackSocketHandle): Integer;
  1284. begin
  1285. Result := __close(ASocket);
  1286. end;
  1287. function TIdStackVCLPosix.WSGetLastError: Integer;
  1288. begin
  1289. //IdStackWindows just uses result := WSAGetLastError;
  1290. Result := GetLastError; //System.GetLastOSError; - FPC doesn't define it in System
  1291. if Result = Id_WSAEPIPE then begin
  1292. Result := Id_WSAECONNRESET;
  1293. end;
  1294. end;
  1295. function TIdStackVCLPosix.WSGetServByName(const AServiceName: string): TIdPort;
  1296. var
  1297. Lps: PServEnt;
  1298. {$IFDEF USE_MARSHALLED_PTRS}
  1299. M: TMarshaller;
  1300. {$ENDIF}
  1301. begin
  1302. Lps := Posix.NetDB.getservbyname(
  1303. {$IFDEF USE_MARSHALLED_PTRS}
  1304. M.AsAnsi(AServiceName).ToPointer
  1305. {$ELSE}
  1306. PAnsiChar(AnsiString(AServiceName)) // explicit convert to Ansi
  1307. {$ENDIF},
  1308. nil);
  1309. if Lps <> nil then begin
  1310. Result := ntohs(Lps^.s_port);
  1311. end else begin
  1312. try
  1313. Result := IndyStrToInt(AServiceName);
  1314. except
  1315. on EConvertError do begin
  1316. Result := 0;
  1317. IndyRaiseOuterException(EIdInvalidServiceName.CreateFmt(RSInvalidServiceName, [AServiceName]));
  1318. end;
  1319. end;
  1320. end;
  1321. end;
  1322. procedure TIdStackVCLPosix.AddServByPortToList(const APortNumber: TIdPort; AAddresses: TStrings);
  1323. //function TIdStackVCLPosix.WSGetServByPort(const APortNumber: TIdPort): TStrings;
  1324. type
  1325. PPAnsiCharArray = ^TPAnsiCharArray;
  1326. TPAnsiCharArray = packed array[0..(MaxInt div SizeOf(PIdAnsiChar))-1] of PIdAnsiChar;
  1327. var
  1328. Lps: PServEnt;
  1329. Li: Integer;
  1330. Lp: PPAnsiCharArray;
  1331. begin
  1332. Lps := Posix.NetDB.getservbyport(htons(APortNumber), nil);
  1333. if Lps <> nil then begin
  1334. AAddresses.BeginUpdate;
  1335. try
  1336. AAddresses.Add(String(Lps^.s_name));
  1337. Li := 0;
  1338. Lp := Pointer(Lps^.s_aliases);
  1339. while Lp[Li] <> nil do begin
  1340. AAddresses.Add(String(Lp[Li]));
  1341. Inc(Li);
  1342. end;
  1343. finally
  1344. AAddresses.EndUpdate;
  1345. end;
  1346. end;
  1347. end;
  1348. function TIdStackVCLPosix.WSRecv(ASocket: TIdStackSocketHandle; var ABuffer;
  1349. const ABufferLength, AFlags: Integer): Integer;
  1350. begin
  1351. //IdStackWindows is just: Result := Recv(ASocket, ABuffer, ABufferLength, AFlags);
  1352. // TODO: only include MSG_NOSIGNAL if SO_NOSIGPIPE is not enabled?
  1353. Result := Posix.SysSocket.Recv(ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL);
  1354. end;
  1355. function TIdStackVCLPosix.WSSend(ASocket: TIdStackSocketHandle; const ABuffer;
  1356. const ABufferLength, AFlags: Integer): Integer;
  1357. begin
  1358. // TODO: only include MSG_NOSIGNAL if SO_NOSIGPIPE is not enabled?
  1359. Result := CheckForSocketError(Posix.SysSocket.send(ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL));
  1360. end;
  1361. procedure TIdStackVCLPosix.WSSendTo(ASocket: TIdStackSocketHandle;
  1362. const ABuffer; const ABufferLength, AFlags: Integer; const AIP: string;
  1363. const APort: TIdPort; AIPVersion: TIdIPVersion);
  1364. var
  1365. LAddrStore: sockaddr_storage;
  1366. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  1367. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  1368. LAddr : sockaddr absolute LAddrStore;
  1369. LiSize: socklen_t;
  1370. LBytesSent: Integer;
  1371. begin
  1372. case AIPVersion of
  1373. Id_IPv4: begin
  1374. InitSockAddr_In(LAddrIPv4);
  1375. TranslateStringToTInAddr(AIP, LAddrIPv4.sin_addr, Id_IPv4);
  1376. LAddrIPv4.sin_port := htons(APort);
  1377. LiSize := SizeOf(LAddrIPv4);
  1378. end;
  1379. Id_IPv6: begin
  1380. InitSockAddr_in6(LAddrIPv6);
  1381. TranslateStringToTInAddr(AIP, LAddrIPv6.sin6_addr, Id_IPv6);
  1382. LAddrIPv6.sin6_port := htons(APort);
  1383. LiSize := SizeOf(LAddrIPv6);
  1384. end;
  1385. else
  1386. LiSize := 0; // avoid warning
  1387. IPVersionUnsupported;
  1388. end;
  1389. // TODO: only include MSG_NOSIGNAL if SO_NOSIGPIPE is not enabled?
  1390. LBytesSent := Posix.SysSocket.sendto(
  1391. ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL, LAddr, LiSize);
  1392. if LBytesSent = Id_SOCKET_ERROR then begin
  1393. // TODO: move this into RaiseLastSocketError directly
  1394. if WSGetLastError() = Id_WSAEMSGSIZE then begin
  1395. raise EIdPackageSizeTooBig.Create(RSPackageSizeTooBig);
  1396. end else begin
  1397. RaiseLastSocketError;
  1398. end;
  1399. end
  1400. else if LBytesSent <> ABufferLength then begin
  1401. raise EIdNotAllBytesSent.Create(RSNotAllBytesSent);
  1402. end;
  1403. end;
  1404. procedure TIdStackVCLPosix.WSSetLastError(const AErr: Integer);
  1405. begin
  1406. __error^ := AErr;
  1407. end;
  1408. function TIdStackVCLPosix.WSShutdown(ASocket: TIdStackSocketHandle;
  1409. AHow: Integer): Integer;
  1410. begin
  1411. Result := Posix.SysSocket.shutdown(ASocket, AHow);
  1412. end;
  1413. function TIdStackVCLPosix.WSSocket(AFamily : Integer; AStruct : TIdSocketType; AProtocol: Integer;
  1414. const ANonBlocking: Boolean = False): TIdStackSocketHandle;
  1415. var
  1416. LFlags: Integer;
  1417. begin
  1418. Result := Posix.SysSocket.socket(AFamily, AStruct, AProtocol);
  1419. if Result <> INVALID_SOCKET then begin
  1420. {$IFDEF HAS_SOCKET_NOSIGPIPE}
  1421. SetSocketOption(Result, SOL_SOCKET, SO_NOSIGPIPE, 1);
  1422. {$ENDIF}
  1423. //SetBlocking(Result, not ANonBlocking);
  1424. if ANonBlocking then begin
  1425. LFlags := fcntl(Result, F_GETFL, 0);
  1426. LFlags := LFlags or O_NONBLOCK;
  1427. fcntl(Result, F_SETFL, LFlags);
  1428. end;
  1429. end;
  1430. end;
  1431. {$I IdUnitPlatformOn.inc}
  1432. {$I IdSymbolPlatformOn.inc}
  1433. initialization
  1434. GSocketListClass := TIdSocketListVCLPosix;
  1435. {$I IdOptimizationsOn.inc}
  1436. end.