IdStackVCLPosix.pas 47 KB

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