IdStackVCLPosix.pas 47 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509
  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 USE_VCL_POSIX}
  24. {$IFDEF ANDROID}
  25. EIdAccessWifiStatePermissionNeeded = class(EIdAndroidPermissionNeeded);
  26. EIdAccessNetworkStatePermissionNeeded = class(EIdAndroidPermissionNeeded);
  27. {$ENDIF}
  28. {$ENDIF}
  29. // TODO: move this class into the implementation section! It is not used outside of this unit
  30. TIdSocketListVCLPosix = class (TIdSocketList)
  31. protected
  32. FCount: Integer;
  33. FFDSet: fd_set;
  34. //
  35. class function FDSelect(AReadSet, AWriteSet,
  36. AExceptSet: Pfd_set; const ATimeout: Integer): Integer;
  37. function GetItem(AIndex: Integer): TIdStackSocketHandle; override;
  38. public
  39. procedure Add(AHandle: TIdStackSocketHandle); override;
  40. procedure Remove(AHandle: TIdStackSocketHandle); override;
  41. function Count: Integer; override;
  42. procedure Clear; override;
  43. function Clone: TIdSocketList; override;
  44. function ContainsSocket(AHandle: TIdStackSocketHandle): Boolean; override;
  45. procedure GetFDSet(var VSet: fd_set);
  46. procedure SetFDSet(var VSet: fd_set);
  47. class function Select(AReadList: TIdSocketList; AWriteList: TIdSocketList;
  48. AExceptList: TIdSocketList; const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  49. function SelectRead(const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  50. function SelectReadList(var VSocketList: TIdSocketList;
  51. const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  52. end;
  53. TIdStackVCLPosix = class(TIdStackBSDBase)
  54. protected
  55. procedure WriteChecksumIPv6(s: TIdStackSocketHandle; var VBuffer: TIdBytes;
  56. const AOffset: Integer; const AIP: String; const APort: TIdPort);
  57. function GetLastError: Integer;
  58. procedure SetLastError(const AError: Integer);
  59. function HostByName(const AHostName: string;
  60. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
  61. function ReadHostName: string; override;
  62. function WSCloseSocket(ASocket: TIdStackSocketHandle): Integer; override;
  63. function WSRecv(ASocket: TIdStackSocketHandle; var ABuffer;
  64. const ABufferLength, AFlags: Integer): Integer; override;
  65. function WSSend(ASocket: TIdStackSocketHandle; const ABuffer;
  66. const ABufferLength, AFlags: Integer): Integer; override;
  67. function WSShutdown(ASocket: TIdStackSocketHandle; AHow: Integer): Integer; override;
  68. {$IFNDEF VCL_XE3_OR_ABOVE}
  69. procedure WSGetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  70. AOptName: TIdSocketOption; var AOptVal; var AOptLen: Integer); override;
  71. procedure WSSetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  72. AOptName: TIdSocketOption; const AOptVal; const AOptLen: Integer); override;
  73. {$ENDIF}
  74. public
  75. constructor Create; override;
  76. destructor Destroy; override;
  77. procedure SetBlocking(ASocket: TIdStackSocketHandle; const ABlocking: Boolean); override;
  78. function WouldBlock(const AResult: Integer): Boolean; override;
  79. function Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort;
  80. var VIPVersion: TIdIPVersion): TIdStackSocketHandle; override;
  81. procedure Bind(ASocket: TIdStackSocketHandle; const AIP: string;
  82. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  83. procedure Connect(const ASocket: TIdStackSocketHandle; const AIP: string;
  84. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  85. function HostByAddress(const AAddress: string;
  86. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
  87. function WSGetLastError: Integer; override;
  88. procedure WSSetLastError(const AErr : Integer); override;
  89. function WSGetServByName(const AServiceName: string): TIdPort; override;
  90. procedure AddServByPortToList(const APortNumber: TIdPort; AAddresses: TStrings); override;
  91. procedure GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string;
  92. var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
  93. procedure GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string;
  94. var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
  95. procedure Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer); override;
  96. function HostToNetwork(AValue: UInt16): UInt16; override;
  97. function NetworkToHost(AValue: UInt16): UInt16; override;
  98. function HostToNetwork(AValue: UInt32): UInt32; override;
  99. function NetworkToHost(AValue: UInt32): UInt32; override;
  100. function HostToNetwork(AValue: TIdUInt64): TIdUInt64; override;
  101. function NetworkToHost(AValue: TIdUInt64): TIdUInt64; override;
  102. function RecvFrom(const ASocket: TIdStackSocketHandle;
  103. var VBuffer; const ALength, AFlags: Integer; var VIP: string;
  104. var VPort: TIdPort; var VIPVersion: TIdIPVersion): Integer; override;
  105. function ReceiveMsg(ASocket: TIdStackSocketHandle;
  106. var VBuffer: TIdBytes; APkt: TIdPacketInfo): UInt32; override;
  107. procedure WSSendTo(ASocket: TIdStackSocketHandle; const ABuffer;
  108. const ABufferLength, AFlags: Integer; const AIP: string; const APort: TIdPort;
  109. AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  110. function WSSocket(AFamily : Integer; AStruct : TIdSocketType; AProtocol: Integer;
  111. const ANonBlocking: Boolean = False): TIdStackSocketHandle; override;
  112. procedure Disconnect(ASocket: TIdStackSocketHandle); override;
  113. {$IFDEF VCL_XE3_OR_ABOVE}
  114. procedure GetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  115. AOptName: TIdSocketOption; var AOptVal; var AOptLen: Integer); override;
  116. procedure SetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  117. AOptName: TIdSocketOption; const AOptVal; const AOptLen: Integer); override;
  118. {$ENDIF}
  119. function SupportsIPv4: Boolean; overload; override;
  120. function SupportsIPv6: Boolean; overload; override;
  121. function CheckIPVersionSupport(const AIPVersion: TIdIPVersion): boolean; override;
  122. //In Windows, this writes a checksum into a buffer. In Linux, it would probably
  123. //simply have the kernal write the checksum with something like this (RFC 2292):
  124. //
  125. // int offset = 2;
  126. // setsockopt(fd, IPPROTO_IPV6, IPV6_CHECKSUM, &offset, sizeof(offset));
  127. //
  128. // Note that this should be called
  129. //IMMEDIATELY before you do a SendTo because the Local IPv6 address might change
  130. procedure WriteChecksum(s : TIdStackSocketHandle; var VBuffer : TIdBytes;
  131. const AOffset : Integer; const AIP : String; const APort : TIdPort;
  132. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  133. function IOControl(const s: TIdStackSocketHandle; const cmd: UInt32;
  134. var arg: UInt32): Integer; override;
  135. procedure GetLocalAddressList(AAddresses: TIdStackLocalAddressList); override;
  136. end;
  137. implementation
  138. {$O-}
  139. uses
  140. IdResourceStrings,
  141. IdResourceStringsUnix,
  142. IdResourceStringsVCLPosix,
  143. IdException,
  144. IdVCLPosixSupplemental,
  145. Posix.Base,
  146. Posix.ArpaInet,
  147. Posix.Errno,
  148. Posix.NetDB,
  149. {$IFDEF HAS_getifaddrs}
  150. Posix.NetIf,
  151. {$ENDIF}
  152. Posix.NetinetIn,
  153. Posix.StrOpts,
  154. Posix.SysTypes,
  155. Posix.SysUio,
  156. Posix.Unistd,
  157. Posix.Fcntl,
  158. SysUtils;
  159. {$UNDEF HAS_MSG_NOSIGNAL}
  160. {$IFDEF LINUX} //this LINUX ifdef is deliberate
  161. {$DEFINE HAS_MSG_NOSIGNAL}
  162. {$ENDIF}
  163. const
  164. {$IFDEF HAS_MSG_NOSIGNAL}
  165. //fancy little trick since OS X does not have MSG_NOSIGNAL
  166. Id_MSG_NOSIGNAL = MSG_NOSIGNAL;
  167. {$ELSE}
  168. Id_MSG_NOSIGNAL = 0;
  169. {$ENDIF}
  170. Id_WSAEPIPE = EPIPE;
  171. //helper functions for some structs
  172. {Note: These hide an API difference in structures.
  173. BSD 4.4 introduced a minor API change. sa_family was changed from a 16bit
  174. word to an 8 bit byteee and an 8 bit byte feild named sa_len was added.
  175. }
  176. procedure InitSockAddr_In(var VSock : SockAddr_In);
  177. {$IFDEF USE_INLINE} inline; {$ENDIF}
  178. begin
  179. FillChar(VSock, SizeOf(SockAddr_In), 0);
  180. VSock.sin_family := PF_INET;
  181. {$IFDEF SOCK_HAS_SINLEN}
  182. VSock.sin_len := SizeOf(SockAddr_In);
  183. {$ENDIF}
  184. end;
  185. procedure InitSockAddr_in6(var VSock : SockAddr_in6);
  186. {$IFDEF USE_INLINE} inline; {$ENDIF}
  187. begin
  188. FillChar(VSock, SizeOf(SockAddr_in6), 0);
  189. {$IFDEF SOCK_HAS_SINLEN}
  190. VSock.sin6_len := SizeOf(SockAddr_in6);
  191. {$ENDIF}
  192. VSock.sin6_family := PF_INET6;
  193. end;
  194. //
  195. { TIdSocketListVCLPosix }
  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. FreeAndNil(Result);
  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. // TODO: implement getifaddrs() manually using code from 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: 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. LAddress := TIdStackLocalAddressIPv4.Create(AAddresses, TranslateTInAddrToString( PSockAddr_In(LAddrInfo^.ifa_addr)^.sin_addr, Id_IPv4), LSubNetStr);
  506. end;
  507. Id_PF_INET6: begin
  508. LAddress := TIdStackLocalAddressIPv6.Create(AAddresses, TranslateTInAddrToString( PSockAddr_In6(LAddrInfo^.ifa_addr)^.sin6_addr, Id_IPv6));
  509. end;
  510. end;
  511. if LAddress <> nil then begin
  512. LName := String(LAddrInfo^.ifa_name);
  513. TIdStackLocalAddressAccess(LAddress).FDescription := LName;
  514. TIdStackLocalAddressAccess(LAddress).FFriendlyName := LName;
  515. TIdStackLocalAddressAccess(LAddress).FInterfaceName := LName;
  516. {$IFDEF HAS_if_nametoindex}
  517. TIdStackLocalAddressAccess(LAddress).FInterfaceIndex := if_nametoindex(LAddrInfo^.ifa_name);
  518. {$ENDIF}
  519. end;
  520. end;
  521. LAddrInfo := LAddrInfo^.ifa_next;
  522. until LAddrInfo = nil;
  523. finally
  524. AAddresses.EndUpdate;
  525. end;
  526. finally
  527. freeifaddrs(LAddrList);
  528. end;
  529. {$ELSE}
  530. // TODO: on Android, either implement getifaddrs() (https://github.com/morristech/android-ifaddrs)
  531. // or use the Java API to enumerate the local network interfaces and their IP addresses, eg:
  532. {
  533. var
  534. en, enumIpAddr: Enumeration;
  535. intf: NetworkInterface;
  536. inetAddress: InetAddress;
  537. LAddress: TIdStackLocalAddress;
  538. begin
  539. try
  540. en := NetworkInterface.getNetworkInterfaces;
  541. if en.hasMoreElements then begin
  542. AAddresses.BeginUpdate;
  543. try
  544. repeat
  545. intf := en.nextElement;
  546. enumIpAddr := intf.getInetAddresses;
  547. while enumIpAddr.hasMoreElements do begin
  548. inetAddress := enumIpAddr.nextElement;
  549. if not inetAddress.isLoopbackAddress then begin
  550. LAddress := nil;
  551. if (inetAddress instanceof Inet4Address) then begin
  552. LAddress := TIdStackLocalAddressIPv4.Create(AAddresses, inetAddress.getHostAddress.toString, ''); // TODO: subnet mask
  553. end
  554. else if (inetAddress instanceof Inet6Address) then begin
  555. LAddress := TIdStackLocalAddressIPv6.Create(AAddresses, inetAddress.getHostAddress.toString);
  556. end;
  557. if LAddress <> nil then begin
  558. TIdStackLocalAddressAccess(LAddress).FDescription := intf.getDisplayName;
  559. TIdStackLocalAddressAccess(LAddress).FInterfaceName := intf.getName;
  560. TIdStackLocalAddressAccess(LAddress).FInterfaceIndex := intf.getIndex (+1?);
  561. end;
  562. end;
  563. end;
  564. until not en.hasMoreElements;
  565. finally
  566. AAddresses.EndUpdate;
  567. end;
  568. end;
  569. except
  570. if not HasAndroidPermission('android.permission.ACCESS_NETWORK_STATE') then begin
  571. IndyRaiseOuterException(EIdAccessNetworkStatePermissionNeeded.CreateError(0, ''));
  572. end;
  573. if not HasAndroidPermission('android.permission.INTERNET') then begin
  574. IndyRaiseOuterException(EIdInternetPermissionNeeded.CreateError(0, ''));
  575. end;
  576. raise;
  577. end;
  578. end;
  579. Note that this requires the application to have ACCESS_NETWORK_STATE and INTERNET permissions.
  580. Or:
  581. uses
  582. if XE7+
  583. Androidapi.Helpers
  584. else
  585. FMX.Helpers.Android
  586. ;
  587. var
  588. LWifiManager: WifiManager;
  589. LWifiInfo: WifiInfo;
  590. LIPAddress: Integer;
  591. LAddress: TIdStackLocalAddressIPv4;
  592. begin
  593. try
  594. LWifiManager := (WifiManager) GetActivityContext.getSystemService(WIFI_SERVICE);
  595. LWifiInfo := LWifiManager.getConnectionInfo;
  596. LIPAddress := LWifiInfo.getIpAddress;
  597. // TODO: can we use the NetworkId or MacAddress to help find the network interface name and index?
  598. except
  599. if not HasAndroidPermission('android.permission.ACCESS_WIFI_STATE') then begin
  600. IndyRaiseOuterException(EIdAccessWifiStatePermissionNeeded.CreateError(0, ''));
  601. end;
  602. raise;
  603. end;
  604. // WiFiInfo only supports IPv4
  605. LAddress := TIdStackLocalAddressIPv4.Create(AAddresses,
  606. Format('%d.%d.%d.%d', [LIPAddress and $ff, (LIPAddress shr 8) and $ff, (LIPAddress shr 16) and $ff, (LIPAddress shr 24) and $ff]),
  607. '' // TODO: subnet mask
  608. );
  609. LAddress.FDescription := ?; // LWifiInfo.getNetworkId()? LWifiInfo.getSSID()? LWifiInfo.toString()?
  610. LAddress.FInterfaceName := ?;
  611. LAddress.FInterfaceIndex := ?;
  612. end;
  613. This requires only ACCESS_WIFI_STATE permission.
  614. }
  615. //IMPORTANT!!!
  616. //
  617. //The Hints structure must be zeroed out or you might get an AV.
  618. //I've seen this in Mac OS X
  619. FillChar(Hints, SizeOf(Hints), 0);
  620. Hints.ai_family := PF_UNSPEC; // returns both IPv4 and IPv6 addresses
  621. Hints.ai_socktype := SOCK_STREAM;
  622. LHostName := HostName;
  623. LRetVal := getaddrinfo(
  624. {$IFDEF USE_MARSHALLED_PTRS}
  625. M.AsAnsi(LHostName).ToPointer
  626. {$ELSE}
  627. PAnsiChar(
  628. {$IFDEF STRING_IS_ANSI}
  629. LHostName
  630. {$ELSE}
  631. AnsiString(LHostName) // explicit convert to Ansi
  632. {$ENDIF}
  633. )
  634. {$ENDIF},
  635. nil, Hints, LAddrList);
  636. if LRetVal <> 0 then begin
  637. if LRetVal = EAI_SYSTEM then begin
  638. RaiseLastOSError;
  639. end else begin
  640. raise EIdReverseResolveError.CreateFmt(RSReverseResolveError, [LHostName, gai_strerror(LRetVal), LRetVal]);
  641. end;
  642. end;
  643. try
  644. AAddresses.BeginUpdate;
  645. try
  646. LAddrInfo := LAddrList;
  647. repeat
  648. case LAddrInfo^.ai_addr^.sa_family of
  649. Id_PF_INET4 :
  650. begin
  651. TIdStackLocalAddressIPv4.Create(AAddresses, TranslateTInAddrToString( PSockAddr_In(LAddrInfo^.ai_addr)^.sin_addr, Id_IPv4), ''); // TODO: SubNet
  652. end;
  653. Id_PF_INET6 :
  654. begin
  655. TIdStackLocalAddressIPv6.Create(AAddresses, TranslateTInAddrToString( PSockAddr_In6(LAddrInfo^.ai_addr)^.sin6_addr, Id_IPv6));
  656. end;
  657. end;
  658. LAddrInfo := LAddrInfo^.ai_next;
  659. until LAddrInfo = nil;
  660. finally
  661. AAddresses.EndUpdate;
  662. end;
  663. finally
  664. freeaddrinfo(LAddrList^);
  665. end;
  666. {$ENDIF}
  667. end;
  668. procedure TIdStackVCLPosix.Bind(ASocket: TIdStackSocketHandle;
  669. const AIP: string; const APort: TIdPort; const AIPVersion: TIdIPVersion);
  670. var
  671. LAddrStore: sockaddr_storage;
  672. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  673. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  674. LAddr : sockaddr absolute LAddrStore;
  675. begin
  676. case AIPVersion of
  677. Id_IPv4: begin
  678. InitSockAddr_In(LAddrIPv4);
  679. if AIP <> '' then begin
  680. TranslateStringToTInAddr(AIP, LAddrIPv4.sin_addr, Id_IPv4);
  681. end;
  682. LAddrIPv4.sin_port := htons(APort);
  683. CheckForSocketError(Posix.SysSocket.bind(ASocket, LAddr, SizeOf(LAddrIPv4)));
  684. end;
  685. Id_IPv6: begin
  686. InitSockAddr_in6(LAddrIPv6);
  687. if AIP <> '' then begin
  688. TranslateStringToTInAddr(AIP, LAddrIPv6.sin6_addr, Id_IPv6);
  689. end;
  690. LAddrIPv6.sin6_port := htons(APort);
  691. CheckForSocketError(Posix.SysSocket.bind(ASocket,LAddr, SizeOf(LAddrIPv6)));
  692. end;
  693. else begin
  694. IPVersionUnsupported;
  695. end;
  696. end;
  697. end;
  698. function TIdStackVCLPosix.CheckIPVersionSupport(
  699. const AIPVersion: TIdIPVersion): boolean;
  700. var
  701. LTmpSocket: TIdStackSocketHandle;
  702. begin
  703. // TODO: on nix systems (or maybe just Linux?), an alternative would be to
  704. // check for the existance of the '/proc/net/if_inet6' kernel pseudo-file
  705. LTmpSocket := WSSocket(IdIPFamily[AIPVersion], Id_SOCK_STREAM, Id_IPPROTO_IP );
  706. Result := LTmpSocket <> Id_INVALID_SOCKET;
  707. if Result then begin
  708. WSCloseSocket(LTmpSocket);
  709. end;
  710. end;
  711. procedure TIdStackVCLPosix.Connect(const ASocket: TIdStackSocketHandle;
  712. const AIP: string; const APort: TIdPort; const AIPVersion: TIdIPVersion);
  713. var
  714. LAddrStore: sockaddr_storage;
  715. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  716. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  717. LAddr : sockaddr absolute LAddrStore;
  718. begin
  719. case AIPVersion of
  720. Id_IPv4: begin
  721. InitSockAddr_In(LAddrIPv4);
  722. TranslateStringToTInAddr(AIP, LAddrIPv4.sin_addr, Id_IPv4);
  723. LAddrIPv4.sin_port := htons(APort);
  724. CheckForSocketError(Posix.SysSocket.connect(ASocket, LAddr, SizeOf(LAddrIPv4)));
  725. end;
  726. Id_IPv6: begin
  727. InitSockAddr_in6(LAddrIPv6);
  728. TranslateStringToTInAddr(AIP, LAddrIPv6.sin6_addr, Id_IPv6);
  729. LAddrIPv6.sin6_port := htons(APort);
  730. CheckForSocketError(Posix.SysSocket.connect(ASocket, LAddr, SizeOf(LAddrIPv6)));
  731. end;
  732. else begin
  733. IPVersionUnsupported;
  734. end;
  735. end;
  736. end;
  737. constructor TIdStackVCLPosix.Create;
  738. begin
  739. inherited Create;
  740. end;
  741. destructor TIdStackVCLPosix.Destroy;
  742. begin
  743. inherited Destroy;
  744. end;
  745. procedure TIdStackVCLPosix.Disconnect(ASocket: TIdStackSocketHandle);
  746. begin
  747. // Windows uses Id_SD_Send, Linux should use Id_SD_Both
  748. WSShutdown(ASocket, Id_SD_Both);
  749. // SO_LINGER is false - socket may take a little while to actually close after this
  750. WSCloseSocket(ASocket);
  751. end;
  752. function TIdStackVCLPosix.GetLastError: Integer;
  753. begin
  754. Result := errno;
  755. end;
  756. procedure TIdStackVCLPosix.GetPeerName(ASocket: TIdStackSocketHandle;
  757. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion);
  758. var
  759. i: socklen_t;
  760. LAddrStore: sockaddr_storage;
  761. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  762. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  763. LAddr : sockaddr absolute LAddrStore;
  764. begin
  765. i := SizeOf(LAddrStore);
  766. CheckForSocketError(Posix.SysSocket.getpeername(ASocket, LAddr, i));
  767. case LAddrStore.ss_family of
  768. Id_PF_INET4: begin
  769. VIP := TranslateTInAddrToString(LAddrIPv4.sin_addr, Id_IPv4);
  770. VPort := ntohs(LAddrIPv4.sin_port);
  771. VIPVersion := Id_IPV4;
  772. end;
  773. Id_PF_INET6: begin
  774. VIP := TranslateTInAddrToString(LAddrIPv6.sin6_addr, Id_IPv6);
  775. VPort := ntohs(LAddrIPv6.sin6_port);
  776. VIPVersion := Id_IPV6;
  777. end;
  778. else begin
  779. IPVersionUnsupported;
  780. end;
  781. end;
  782. end;
  783. procedure TIdStackVCLPosix.GetSocketName(ASocket: TIdStackSocketHandle;
  784. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion);
  785. var
  786. LiSize: socklen_t;
  787. LAddrStore: sockaddr_storage;
  788. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  789. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  790. LAddr : sockaddr absolute LAddrStore;
  791. begin
  792. LiSize := SizeOf(LAddrStore);
  793. CheckForSocketError(getsockname(ASocket, LAddr, LiSize));
  794. case LAddrStore.ss_family of
  795. Id_PF_INET4: begin
  796. VIP := TranslateTInAddrToString(LAddrIPv4.sin_addr, Id_IPv4);
  797. VPort := ntohs(LAddrIPv4.sin_port);
  798. VIPVersion := Id_IPV4;
  799. end;
  800. Id_PF_INET6: begin
  801. VIP := TranslateTInAddrToString(LAddrIPv6.sin6_addr, Id_IPv6);
  802. VPort := ntohs(LAddrIPv6.sin6_port);
  803. VIPVersion := Id_IPV6;
  804. end;
  805. else begin
  806. IPVersionUnsupported;
  807. end;
  808. end;
  809. end;
  810. function TIdStackVCLPosix.HostByAddress(const AAddress: string;
  811. const AIPVersion: TIdIPVersion): string;
  812. var
  813. LiSize: socklen_t;
  814. LAddrStore: sockaddr_storage;
  815. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  816. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  817. LAddr : sockaddr absolute LAddrStore;
  818. LHostName : array[0..NI_MAXHOST] of TIdAnsiChar;
  819. {$IFDEF USE_MARSHALLED_PTRS}
  820. LHostNamePtr: TPtrWrapper;
  821. {$ENDIF}
  822. LRet : Integer;
  823. LHints : addrinfo;
  824. LAddrInfo: pAddrInfo;
  825. begin
  826. LiSize := 0;
  827. case AIPVersion of
  828. Id_IPv4 :
  829. begin
  830. InitSockAddr_In(LAddrIPv4);
  831. TranslateStringToTInAddr(AAddress,LAddrIPv4.sin_addr,Id_IPv4);
  832. LiSize := SizeOf(SockAddr_In);
  833. end;
  834. Id_IPv6 :
  835. begin
  836. InitSockAddr_In6(LAddrIPv6);
  837. TranslateStringToTInAddr(AAddress,LAddrIPv6.sin6_addr,Id_IPv6);
  838. LiSize := SizeOf(SockAddr_In6);
  839. end
  840. else
  841. IPVersionUnsupported;
  842. end;
  843. FillChar(LHostName[0],Length(LHostName),0);
  844. {$IFDEF USE_MARSHALLED_PTRS}
  845. LHostNamePtr := TPtrWrapper.Create(@LHostName[0]);
  846. {$ENDIF}
  847. LRet := getnameinfo(LAddr,LiSize,
  848. {$IFDEF USE_MARSHALLED_PTRS}
  849. LHostNamePtr.ToPointer
  850. {$ELSE}
  851. LHostName
  852. {$ENDIF},
  853. NI_MAXHOST,nil,0,NI_NAMEREQD );
  854. if LRet <> 0 then begin
  855. if LRet = EAI_SYSTEM then begin
  856. RaiseLastOSError;
  857. end else begin
  858. raise EIdReverseResolveError.CreateFmt(RSReverseResolveError, [AAddress, gai_strerror(LRet), LRet]);
  859. end;
  860. end;
  861. {
  862. IMPORTANT!!!
  863. getnameinfo can return either results from a numeric to text conversion or
  864. results from a DNS reverse lookup. Someone could make a malicous PTR record
  865. such as
  866. 1.0.0.127.in-addr.arpa. IN PTR 10.1.1.1
  867. and trick a caller into beleiving the socket address is 10.1.1.1 instead of
  868. 127.0.0.1. If there is a numeric host in LAddr, than this is the case and
  869. we disregard the result and raise an exception.
  870. }
  871. FillChar(LHints, SizeOf(LHints), 0);
  872. LHints.ai_socktype := SOCK_DGRAM; //*dummy*/
  873. LHints.ai_flags := AI_NUMERICHOST;
  874. if getaddrinfo(
  875. {$IFDEF USE_MARSHALLED_PTRS}
  876. LHostNamePtr.ToPointer
  877. {$ELSE}
  878. LHostName
  879. {$ENDIF},
  880. '0', LHints, LAddrInfo) = 0 then
  881. begin
  882. freeaddrinfo(LAddrInfo^);
  883. Result := '';
  884. raise EIdMaliciousPtrRecord.Create(RSMaliciousPtrRecord);
  885. end;
  886. {$IFDEF USE_MARSHALLED_PTRS}
  887. Result := TMarshal.ReadStringAsAnsi(LHostNamePtr);
  888. {$ELSE}
  889. Result := String(LHostName);
  890. {$ENDIF}
  891. end;
  892. function TIdStackVCLPosix.HostByName(const AHostName: string;
  893. const AIPVersion: TIdIPVersion): string;
  894. var
  895. LAddrInfo: pAddrInfo;
  896. LHints: AddrInfo;
  897. LRetVal: Integer;
  898. {$IFDEF USE_MARSHALLED_PTRS}
  899. M: TMarshaller;
  900. {$ENDIF}
  901. begin
  902. if not (AIPVersion in [Id_IPv4, Id_IPv6]) then begin
  903. IPVersionUnsupported;
  904. end;
  905. //IMPORTANT!!!
  906. //
  907. //The Hints structure must be zeroed out or you might get an AV.
  908. //I've seen this in Mac OS X
  909. FillChar(LHints, SizeOf(LHints), 0);
  910. LHints.ai_family := IdIPFamily[AIPVersion];
  911. LHints.ai_socktype := SOCK_STREAM;
  912. LAddrInfo := nil;
  913. LRetVal := getaddrinfo(
  914. {$IFDEF USE_MARSHALLED_PTRS}
  915. M.AsAnsi(AHostName).ToPointer
  916. {$ELSE}
  917. PAnsiChar(
  918. {$IFDEF STRING_IS_ANSI}
  919. AHostName
  920. {$ELSE}
  921. AnsiString(AHostName) // explicit convert to Ansi
  922. {$ENDIF}
  923. )
  924. {$ENDIF},
  925. nil, LHints, LAddrInfo);
  926. if LRetVal <> 0 then begin
  927. if LRetVal = EAI_SYSTEM then begin
  928. RaiseLastOSError;
  929. end else begin
  930. raise EIdResolveError.CreateFmt(RSReverseResolveError, [AHostName, gai_strerror(LRetVal), LRetVal]);
  931. end;
  932. end;
  933. try
  934. if AIPVersion = Id_IPv4 then begin
  935. Result := TranslateTInAddrToString( PSockAddr_In( LAddrInfo^.ai_addr)^.sin_addr, AIPVersion);
  936. end else begin
  937. Result := TranslateTInAddrToString( PSockAddr_In6( LAddrInfo^.ai_addr)^.sin6_addr, AIPVersion);
  938. end;
  939. finally
  940. freeaddrinfo(LAddrInfo^);
  941. end;
  942. end;
  943. function TIdStackVCLPosix.HostToNetwork(AValue: UInt32): UInt32;
  944. begin
  945. Result := htonl(AValue);
  946. end;
  947. function TIdStackVCLPosix.HostToNetwork(AValue: UInt16): UInt16;
  948. begin
  949. Result := htons(AValue);
  950. end;
  951. function TIdStackVCLPosix.HostToNetwork(AValue: TIdUInt64): TIdUInt64;
  952. var
  953. LParts: TIdUInt64Parts;
  954. L: UInt32;
  955. begin
  956. if (htonl(1) <> 1) then begin
  957. LParts.QuadPart := AValue;
  958. L := htonl(LParts.HighPart);
  959. LParts.HighPart := htonl(LParts.LowPart);
  960. LParts.LowPart := L;
  961. Result := LParts.QuadPart;
  962. end else begin
  963. Result := AValue;
  964. end;
  965. end;
  966. function TIdStackVCLPosix.IOControl(const s: TIdStackSocketHandle;
  967. const cmd: UInt32; var arg: UInt32): Integer;
  968. begin
  969. Result := ioctl(s, cmd, @arg);
  970. end;
  971. procedure TIdStackVCLPosix.Listen(ASocket: TIdStackSocketHandle;
  972. ABackLog: Integer);
  973. begin
  974. CheckForSocketError(Posix.SysSocket.listen(ASocket, ABacklog));
  975. end;
  976. function TIdStackVCLPosix.NetworkToHost(AValue: UInt32): UInt32;
  977. begin
  978. Result := ntohl(AValue);
  979. end;
  980. function TIdStackVCLPosix.NetworkToHost(AValue: TIdUInt64): TIdUInt64;
  981. var
  982. LParts: TIdUInt64Parts;
  983. L: UInt32;
  984. begin
  985. if (ntohl(1) <> 1) then begin
  986. LParts.QuadPart := AValue;
  987. L := ntohl(LParts.HighPart);
  988. LParts.HighPart := ntohl(LParts.LowPart);
  989. LParts.LowPart := L;
  990. Result := LParts.QuadPart;
  991. end else begin
  992. Result := AValue;
  993. end;
  994. end;
  995. function TIdStackVCLPosix.NetworkToHost(AValue: UInt16): UInt16;
  996. begin
  997. Result := ntohs(AValue);
  998. end;
  999. function TIdStackVCLPosix.ReadHostName: string;
  1000. const
  1001. sMaxHostSize = 250;
  1002. var
  1003. LStr: array[0..sMaxHostSize] of TIdAnsiChar;
  1004. {$IFDEF USE_MARSHALLED_PTRS}
  1005. LStrPtr: TPtrWrapper;
  1006. {$ENDIF}
  1007. begin
  1008. {$IFDEF USE_MARSHALLED_PTRS}
  1009. LStrPtr := TPtrWrapper.Create(@LStr[0]);
  1010. {$ENDIF}
  1011. if gethostname(
  1012. {$IFDEF USE_MARSHALLED_PTRS}
  1013. LStrPtr.ToPointer
  1014. {$ELSE}
  1015. LStr
  1016. {$ENDIF}, sMaxHostSize) = 0 then
  1017. begin
  1018. {$IFDEF USE_MARSHALLED_PTRS}
  1019. Result := TMarshal.ReadStringAsAnsiUpTo(0, LStrPtr, sMaxHostSize);
  1020. {$ELSE}
  1021. LStr[sMaxHostSize] := TIdAnsiChar(0);
  1022. Result := String(LStr);
  1023. {$ENDIF}
  1024. end else begin
  1025. Result := '';
  1026. end;
  1027. end;
  1028. function TIdStackVCLPosix.ReceiveMsg(ASocket: TIdStackSocketHandle;
  1029. var VBuffer: TIdBytes; APkt: TIdPacketInfo): UInt32;
  1030. var
  1031. LSize: socklen_t;
  1032. LAddrStore: sockaddr_storage;
  1033. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  1034. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  1035. LAddr : sockaddr absolute LAddrStore;
  1036. LMsg : msghdr;
  1037. LIOV : iovec;
  1038. LControl : TIdBytes;
  1039. LCurCmsg : Pcmsghdr; //for iterating through the control buffer
  1040. LByte : PByte;
  1041. begin
  1042. //we call the macro twice because we specified two possible structures.
  1043. //Id_IPV6_HOPLIMIT and Id_IPV6_PKTINFO
  1044. LSize := CMSG_SPACE(SizeOf(Byte)) + CMSG_SPACE(SizeOf(in6_pktinfo));
  1045. SetLength(LControl, LSize);
  1046. LIOV.iov_len := Length(VBuffer); // Length(VMsgData);
  1047. LIOV.iov_base := @VBuffer[0]; // @VMsgData[0];
  1048. FillChar(LMsg,SizeOf(LMsg),0);
  1049. LMsg.msg_iov := @LIOV;//lpBuffers := @LMsgBuf;
  1050. LMsg.msg_iovlen := 1;
  1051. LMsg.msg_controllen := LSize;
  1052. LMsg.msg_control := @LControl[0];
  1053. LMsg.msg_name := @LAddr;
  1054. LMsg.msg_namelen := SizeOf(LAddrStore);
  1055. Result := 0;
  1056. CheckForSocketError(RecvMsg(ASocket, LMsg, Result));
  1057. APkt.Reset;
  1058. case LAddrStore.ss_family of
  1059. Id_PF_INET4: begin
  1060. APkt.SourceIP := TranslateTInAddrToString(LAddrIPv4.sin_addr, Id_IPv4);
  1061. APkt.SourcePort := ntohs(LAddrIPv4.sin_port);
  1062. APkt.SourceIPVersion := Id_IPv4;
  1063. end;
  1064. Id_PF_INET6: begin
  1065. APkt.SourceIP := TranslateTInAddrToString(LAddrIPv6.sin6_addr, Id_IPv6);
  1066. APkt.SourcePort := ntohs(LAddrIPv6.sin6_port);
  1067. APkt.SourceIPVersion := Id_IPv6;
  1068. end;
  1069. else begin
  1070. Result := 0; // avoid warning
  1071. IPVersionUnsupported;
  1072. end;
  1073. end;
  1074. LCurCmsg := nil;
  1075. repeat
  1076. LCurCmsg := CMSG_NXTHDR(@LMsg, LCurCmsg);
  1077. if LCurCmsg = nil then begin
  1078. break;
  1079. end;
  1080. case LCurCmsg^.cmsg_type of
  1081. IPV6_PKTINFO : //done this way because IPV6_PKTINF and IP_PKTINFO are both 19
  1082. begin
  1083. case LAddrStore.ss_family of
  1084. Id_PF_INET4: begin
  1085. {$IFDEF IOS}
  1086. ToDo('PKTINFO not implemented for IPv4 under iOS yet');
  1087. {$ELSE}
  1088. {$IFNDEF OSX}
  1089. //This is not supported in OS X.
  1090. with Pin_pktinfo(CMSG_DATA(LCurCmsg))^ do begin
  1091. APkt.DestIP := TranslateTInAddrToString(ipi_addr, Id_IPv4);
  1092. APkt.DestIF := ipi_ifindex;
  1093. end;
  1094. APkt.DestIPVersion := Id_IPv4;
  1095. {$ENDIF}
  1096. {$ENDIF}
  1097. end;
  1098. Id_PF_INET6: begin
  1099. with pin6_pktinfo(CMSG_DATA(LCurCmsg))^ do begin
  1100. APkt.DestIP := TranslateTInAddrToString(ipi6_addr, Id_IPv6);
  1101. APkt.DestIF := ipi6_ifindex;
  1102. end;
  1103. APkt.DestIPVersion := Id_IPv6;
  1104. end;
  1105. end;
  1106. end;
  1107. Id_IPV6_HOPLIMIT :
  1108. begin
  1109. LByte := PByte(CMSG_DATA(LCurCmsg));
  1110. APkt.TTL := LByte^;
  1111. end;
  1112. end;
  1113. until False;
  1114. end;
  1115. function TIdStackVCLPosix.RecvFrom(const ASocket: TIdStackSocketHandle;
  1116. var VBuffer; const ALength, AFlags: Integer; var VIP: string;
  1117. var VPort: TIdPort; var VIPVersion: TIdIPVersion): Integer;
  1118. var
  1119. LiSize: socklen_t;
  1120. LAddrStore: sockaddr_storage;
  1121. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  1122. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  1123. LAddr : sockaddr absolute LAddrStore;
  1124. begin
  1125. LiSize := SizeOf(LAddrStore);
  1126. // TODO: only include MSG_NOSIGNAL if SO_NOSIGPIPE is not enabled?
  1127. Result := Posix.SysSocket.recvfrom(ASocket,VBuffer, ALength, AFlags or Id_MSG_NOSIGNAL, LAddr, LiSize);
  1128. if Result >= 0 then
  1129. begin
  1130. case LAddrStore.ss_family of
  1131. Id_PF_INET4: begin
  1132. VIP := TranslateTInAddrToString(LAddrIPv4.sin_addr, Id_IPv4);
  1133. VPort := ntohs(LAddrIPv4.sin_port);
  1134. VIPVersion := Id_IPV4;
  1135. end;
  1136. Id_PF_INET6: begin
  1137. VIP := TranslateTInAddrToString(LAddrIPv6.sin6_addr, Id_IPv6);
  1138. VPort := ntohs(LAddrIPv6.sin6_port);
  1139. VIPVersion := Id_IPV6;
  1140. end;
  1141. else begin
  1142. Result := 0;
  1143. IPVersionUnsupported;
  1144. end;
  1145. end;
  1146. end;
  1147. end;
  1148. procedure TIdStackVCLPosix.SetBlocking(ASocket: TIdStackSocketHandle;
  1149. const ABlocking: Boolean);
  1150. var
  1151. LFlags: Integer;
  1152. begin
  1153. LFlags := CheckForSocketError(fcntl(ASocket, F_GETFL, 0));
  1154. if ABlocking then begin
  1155. LFlags := LFlags and not O_NONBLOCK;
  1156. end else begin
  1157. LFlags := LFlags or O_NONBLOCK;
  1158. end;
  1159. CheckForSocketError(fcntl(ASocket, F_SETFL, LFlags));
  1160. end;
  1161. procedure TIdStackVCLPosix.SetLastError(const AError: Integer);
  1162. begin
  1163. __error^ := AError;
  1164. end;
  1165. procedure TIdStackVCLPosix.{$IFDEF VCL_XE3_OR_ABOVE}GetSocketOption{$ELSE}WSGetSocketOption{$ENDIF}
  1166. (ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption;
  1167. var AOptVal; var AOptLen: Integer);
  1168. var
  1169. LLen : socklen_t;
  1170. begin
  1171. LLen := AOptLen;
  1172. CheckForSocketError(Posix.SysSocket.getsockopt(ASocket, ALevel, AOptName, AOptVal, LLen));
  1173. AOptLen := LLen;
  1174. end;
  1175. procedure TIdStackVCLPosix.{$IFDEF VCL_XE3_OR_ABOVE}SetSocketOption{$ELSE}WSSetSocketOption{$ENDIF}
  1176. (ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption;
  1177. const AOptVal; const AOptLen: Integer);
  1178. begin
  1179. CheckForSocketError(Posix.SysSocket.setsockopt(ASocket, ALevel, AOptName, AOptVal, AOptLen));
  1180. end;
  1181. function TIdStackVCLPosix.SupportsIPv4: Boolean;
  1182. begin
  1183. {$IFDEF IOS}
  1184. // TODO: iOS 9+ is IPv6-only...
  1185. //Result := ([[[UIDevice currentDevice] systemVersion] compare:'9.0' options:NSNumericSearch] == NSOrderedAscending);
  1186. {$ENDIF}
  1187. //In Windows, this does something else. It checks the LSP's installed.
  1188. Result := CheckIPVersionSupport(Id_IPv4);
  1189. end;
  1190. function TIdStackVCLPosix.SupportsIPv6: Boolean;
  1191. begin
  1192. //In Windows, this does something else. It checks the LSP's installed.
  1193. Result := CheckIPVersionSupport(Id_IPv6);
  1194. end;
  1195. function TIdStackVCLPosix.WouldBlock(const AResult: Integer): Boolean;
  1196. begin
  1197. // using if-else instead of in..range because EAGAIN and EWOULDBLOCK
  1198. // have often the same value and so FPC might report a range error
  1199. Result := (AResult = Id_WSAEAGAIN) or
  1200. (AResult = Id_WSAEWOULDBLOCK) or
  1201. (AResult = Id_WSAEINPROGRESS);
  1202. end;
  1203. procedure TIdStackVCLPosix.WriteChecksum(s: TIdStackSocketHandle;
  1204. var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
  1205. const APort: TIdPort; const AIPVersion: TIdIPVersion);
  1206. begin
  1207. case AIPVersion of
  1208. Id_IPv4 : CopyTIdUInt16(HostToLittleEndian(CalcCheckSum(VBuffer)), VBuffer, AOffset);
  1209. Id_IPv6 : WriteChecksumIPv6(s, VBuffer, AOffset, AIP, APort);
  1210. else
  1211. IPVersionUnsupported;
  1212. end;
  1213. end;
  1214. procedure TIdStackVCLPosix.WriteChecksumIPv6(s: TIdStackSocketHandle;
  1215. var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
  1216. const APort: TIdPort);
  1217. begin
  1218. //we simply request that the kernal write the checksum when the data
  1219. //is sent. All of the parameters required are because Windows is bonked
  1220. //because it doesn't have the IPV6CHECKSUM socket option meaning we have
  1221. //to querry the network interface in TIdStackWindows -- yuck!!
  1222. SetSocketOption(s, Id_IPPROTO_IPV6, IPV6_CHECKSUM, AOffset);
  1223. end;
  1224. function TIdStackVCLPosix.WSCloseSocket(ASocket: TIdStackSocketHandle): Integer;
  1225. begin
  1226. Result := __close(ASocket);
  1227. end;
  1228. function TIdStackVCLPosix.WSGetLastError: Integer;
  1229. begin
  1230. //IdStackWindows just uses result := WSAGetLastError;
  1231. Result := GetLastError; //System.GetLastOSError; - FPC doesn't define it in System
  1232. if Result = Id_WSAEPIPE then begin
  1233. Result := Id_WSAECONNRESET;
  1234. end;
  1235. end;
  1236. function TIdStackVCLPosix.WSGetServByName(const AServiceName: string): TIdPort;
  1237. var
  1238. Lps: PServEnt;
  1239. {$IFDEF USE_MARSHALLED_PTRS}
  1240. M: TMarshaller;
  1241. {$ENDIF}
  1242. begin
  1243. Lps := Posix.NetDB.getservbyname(
  1244. {$IFDEF USE_MARSHALLED_PTRS}
  1245. M.AsAnsi(AServiceName).ToPointer
  1246. {$ELSE}
  1247. PAnsiChar(
  1248. {$IFDEF STRING_IS_ANSI}
  1249. AServiceName
  1250. {$ELSE}
  1251. AnsiString(AServiceName) // explicit convert to Ansi
  1252. {$ENDIF}
  1253. )
  1254. {$ENDIF},
  1255. nil);
  1256. if Lps <> nil then begin
  1257. Result := ntohs(Lps^.s_port);
  1258. end else begin
  1259. try
  1260. Result := IndyStrToInt(AServiceName);
  1261. except
  1262. on EConvertError do begin
  1263. Result := 0;
  1264. IndyRaiseOuterException(EIdInvalidServiceName.CreateFmt(RSInvalidServiceName, [AServiceName]));
  1265. end;
  1266. end;
  1267. end;
  1268. end;
  1269. procedure TIdStackVCLPosix.AddServByPortToList(const APortNumber: TIdPort; AAddresses: TStrings);
  1270. //function TIdStackVCLPosix.WSGetServByPort(const APortNumber: TIdPort): TStrings;
  1271. type
  1272. PPAnsiCharArray = ^TPAnsiCharArray;
  1273. TPAnsiCharArray = packed array[0..(MaxInt div SizeOf(PIdAnsiChar))-1] of PIdAnsiChar;
  1274. var
  1275. Lps: PServEnt;
  1276. Li: Integer;
  1277. Lp: PPAnsiCharArray;
  1278. begin
  1279. Lps := Posix.NetDB.getservbyport(htons(APortNumber), nil);
  1280. if Lps <> nil then begin
  1281. AAddresses.BeginUpdate;
  1282. try
  1283. AAddresses.Add(String(Lps^.s_name));
  1284. Li := 0;
  1285. Lp := Pointer(Lps^.s_aliases);
  1286. while Lp[Li] <> nil do begin
  1287. AAddresses.Add(String(Lp[Li]));
  1288. Inc(Li);
  1289. end;
  1290. finally
  1291. AAddresses.EndUpdate;
  1292. end;
  1293. end;
  1294. end;
  1295. function TIdStackVCLPosix.WSRecv(ASocket: TIdStackSocketHandle; var ABuffer;
  1296. const ABufferLength, AFlags: Integer): Integer;
  1297. begin
  1298. //IdStackWindows is just: Result := Recv(ASocket, ABuffer, ABufferLength, AFlags);
  1299. // TODO: only include MSG_NOSIGNAL if SO_NOSIGPIPE is not enabled?
  1300. Result := Posix.SysSocket.Recv(ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL);
  1301. end;
  1302. function TIdStackVCLPosix.WSSend(ASocket: TIdStackSocketHandle; const ABuffer;
  1303. const ABufferLength, AFlags: Integer): Integer;
  1304. begin
  1305. // TODO: only include MSG_NOSIGNAL if SO_NOSIGPIPE is not enabled?
  1306. Result := CheckForSocketError(Posix.SysSocket.send(ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL));
  1307. end;
  1308. procedure TIdStackVCLPosix.WSSendTo(ASocket: TIdStackSocketHandle;
  1309. const ABuffer; const ABufferLength, AFlags: Integer; const AIP: string;
  1310. const APort: TIdPort; AIPVersion: TIdIPVersion);
  1311. var
  1312. LAddrStore: sockaddr_storage;
  1313. LAddrIPv4 : SockAddr_In absolute LAddrStore;
  1314. LAddrIPv6 : sockaddr_in6 absolute LAddrStore;
  1315. LAddr : sockaddr absolute LAddrStore;
  1316. LiSize: socklen_t;
  1317. LBytesSent: Integer;
  1318. begin
  1319. case AIPVersion of
  1320. Id_IPv4: begin
  1321. InitSockAddr_In(LAddrIPv4);
  1322. TranslateStringToTInAddr(AIP, LAddrIPv4.sin_addr, Id_IPv4);
  1323. LAddrIPv4.sin_port := htons(APort);
  1324. LiSize := SizeOf(LAddrIPv4);
  1325. end;
  1326. Id_IPv6: begin
  1327. InitSockAddr_in6(LAddrIPv6);
  1328. TranslateStringToTInAddr(AIP, LAddrIPv6.sin6_addr, Id_IPv6);
  1329. LAddrIPv6.sin6_port := htons(APort);
  1330. LiSize := SizeOf(LAddrIPv6);
  1331. end;
  1332. else
  1333. LiSize := 0; // avoid warning
  1334. IPVersionUnsupported;
  1335. end;
  1336. // TODO: only include MSG_NOSIGNAL if SO_NOSIGPIPE is not enabled?
  1337. LBytesSent := Posix.SysSocket.sendto(
  1338. ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL, LAddr, LiSize);
  1339. if LBytesSent = Id_SOCKET_ERROR then begin
  1340. // TODO: move this into RaiseLastSocketError directly
  1341. if WSGetLastError() = Id_WSAEMSGSIZE then begin
  1342. raise EIdPackageSizeTooBig.Create(RSPackageSizeTooBig);
  1343. end else begin
  1344. RaiseLastSocketError;
  1345. end;
  1346. end
  1347. else if LBytesSent <> ABufferLength then begin
  1348. raise EIdNotAllBytesSent.Create(RSNotAllBytesSent);
  1349. end;
  1350. end;
  1351. procedure TIdStackVCLPosix.WSSetLastError(const AErr: Integer);
  1352. begin
  1353. __error^ := AErr;
  1354. end;
  1355. function TIdStackVCLPosix.WSShutdown(ASocket: TIdStackSocketHandle;
  1356. AHow: Integer): Integer;
  1357. begin
  1358. Result := Posix.SysSocket.shutdown(ASocket, AHow);
  1359. end;
  1360. function TIdStackVCLPosix.WSSocket(AFamily : Integer; AStruct : TIdSocketType; AProtocol: Integer;
  1361. const ANonBlocking: Boolean = False): TIdStackSocketHandle;
  1362. var
  1363. LFlags: Integer;
  1364. begin
  1365. Result := Posix.SysSocket.socket(AFamily, AStruct, AProtocol);
  1366. if Result <> INVALID_SOCKET then begin
  1367. {$IFDEF HAS_SOCKET_NOSIGPIPE}
  1368. SetSocketOption(Result, SOL_SOCKET, SO_NOSIGPIPE, 1);
  1369. {$ENDIF}
  1370. //SetBlocking(Result, not ANonBlocking);
  1371. if ANonBlocking then begin
  1372. LFlags := fcntl(Result, F_GETFL, 0);
  1373. LFlags := LFlags or O_NONBLOCK;
  1374. fcntl(Result, F_SETFL, LFlags);
  1375. end;
  1376. end;
  1377. end;
  1378. {$I IdUnitPlatformOn.inc}
  1379. {$I IdSymbolPlatformOn.inc}
  1380. initialization
  1381. GSocketListClass := TIdSocketListVCLPosix;
  1382. end.