IdStackLibc.pas 46 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.7 10/26/2004 8:20:04 PM JPMugaas
  18. Fixed some oversights with conversion. OOPS!!!
  19. Rev 1.6 10/26/2004 8:12:32 PM JPMugaas
  20. Now uses TIdStrings and TIdStringList for portability.
  21. Rev 1.5 12/06/2004 15:17:20 CCostelloe
  22. Restructured to correspond with IdStackWindows, now works.
  23. Rev 1.4 07/06/2004 21:31:02 CCostelloe
  24. Kylix 3 changes
  25. Rev 1.3 4/18/04 10:43:22 PM RLebeau
  26. Fixed syntax error
  27. Rev 1.2 4/18/04 10:29:46 PM RLebeau
  28. Renamed Int64Parts structure to TIdInt64Parts
  29. Rev 1.1 4/18/04 2:47:28 PM RLebeau
  30. Conversion support for Int64 values
  31. Removed WSHToNs(), WSNToHs(), WSHToNL(), and WSNToHL() methods, obsolete
  32. Rev 1.0 2004.02.03 3:14:48 PM czhower
  33. Move and updates
  34. Rev 1.3 10/19/2003 5:35:14 PM BGooijen
  35. SetSocketOption
  36. Rev 1.2 2003.10.01 9:11:24 PM czhower
  37. .Net
  38. Rev 1.1 7/5/2003 07:25:50 PM JPMugaas
  39. Added functions to the Linux stack which use the new TIdIPAddress record type
  40. for IP address parameters. I also fixed a compile bug.
  41. Rev 1.0 11/13/2002 08:59:24 AM JPMugaas
  42. }
  43. unit IdStackLibc;
  44. interface
  45. {$i IdCompilerDefines.inc}
  46. uses
  47. Classes,
  48. Libc,
  49. IdStack,
  50. IdStackConsts,
  51. IdGlobal,
  52. IdStackBSDBase;
  53. {$IFDEF DELPHI_CROSS}
  54. {$DEFINE LIBCPASS_STRUCT}
  55. {$ELSE}
  56. {$UNDEF LIBCPASS_STRUCT}
  57. {$ENDIF}
  58. type
  59. TIdStackLibc = class(TIdStackBSDBase)
  60. private
  61. procedure WriteChecksumIPv6(s: TIdStackSocketHandle;
  62. var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
  63. const APort: TIdPort);
  64. protected
  65. function GetLastError : Integer;
  66. procedure SetLastError(Const AError : Integer);
  67. function HostByName(const AHostName: string;
  68. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
  69. function ReadHostName: string; override;
  70. function WSCloseSocket(ASocket: TIdStackSocketHandle): Integer; override;
  71. function WSRecv(ASocket: TIdStackSocketHandle;
  72. var ABuffer; const ABufferLength, AFlags: Integer): Integer; override;
  73. function WSSend(ASocket: TIdStackSocketHandle; const ABuffer; const ABufferLength, AFlags: Integer): Integer; override;
  74. function WSShutdown(ASocket: TIdStackSocketHandle; AHow: Integer): Integer; override;
  75. {$IFNDEF DCC_XE3_OR_ABOVE}
  76. procedure WSGetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  77. AOptName: TIdSocketOption; var AOptVal; var AOptLen: Integer); override;
  78. procedure WSSetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  79. AOptName: TIdSocketOption; const AOptVal; const AOptLen: Integer); override;
  80. {$ENDIF}
  81. public
  82. procedure SetBlocking(ASocket: TIdStackSocketHandle;
  83. const ABlocking: Boolean); override;
  84. function WouldBlock(const AResult: Integer): Boolean; override;
  85. function WSTranslateSocketErrorMsg(const AErr: Integer): string; override;
  86. function Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort;
  87. var VIPVersion: TIdIPVersion): TIdStackSocketHandle; override;
  88. procedure Bind(ASocket: TIdStackSocketHandle; const AIP: string;
  89. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  90. procedure Connect(const ASocket: TIdStackSocketHandle; const AIP: string;
  91. const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  92. function HostByAddress(const AAddress: string;
  93. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
  94. function WSGetLastError: Integer; override;
  95. procedure WSSetLastError(const AErr : Integer); override;
  96. function WSGetServByName(const AServiceName: string): TIdPort; override;
  97. function WSGetServByPort(const APortNumber: TIdPort): TStrings; override;
  98. procedure GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string;
  99. var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
  100. procedure GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string;
  101. var VPort: TIdPort; var VIPVersion: TIdIPVersion); override;
  102. procedure Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer); override;
  103. function HostToNetwork(AValue: UInt16): UInt16; override;
  104. function NetworkToHost(AValue: UInt16): UInt16; override;
  105. function HostToNetwork(AValue: UInt32): UInt32; override;
  106. function NetworkToHost(AValue: UInt32): UInt32; override;
  107. function HostToNetwork(AValue: UInt64): UInt64; override;
  108. function NetworkToHost(AValue: UInt64): UInt64; override;
  109. function RecvFrom(const ASocket: TIdStackSocketHandle; var VBuffer;
  110. const ALength, AFlags: Integer; var VIP: string; var VPort: TIdPort;
  111. AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): Integer; override;
  112. function ReceiveMsg(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes;
  113. APkt: TIdPacketInfo): UInt32; override;
  114. procedure WSSendTo(ASocket: TIdStackSocketHandle; const ABuffer;
  115. const ABufferLength, AFlags: Integer;
  116. const AIP: string; const APort: TIdPort; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  117. function WSSocket(AFamily : Integer; AStruct : TIdSocketType; AProtocol: Integer;
  118. const ANonBlocking: Boolean = False): TIdStackSocketHandle; override;
  119. procedure Disconnect(ASocket: TIdStackSocketHandle); override;
  120. {$IFDEF DCC_XE3_OR_ABOVE}
  121. procedure GetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  122. AOptName: TIdSocketOption; var AOptVal; var AOptLen: Integer); override;
  123. procedure SetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel;
  124. AOptName: TIdSocketOption; const AOptVal; const AOptLen: Integer); override;
  125. {$ENDIF}
  126. procedure SetKeepAliveValues(ASocket: TIdStackSocketHandle;
  127. const AEnabled: Boolean; const ATimeMS, AInterval: Integer); override;
  128. function SupportsIPv4: Boolean; overload; override;
  129. function SupportsIPv6: Boolean; overload; override;
  130. function CheckIPVersionSupport(const AIPVersion: TIdIPVersion): boolean; override;
  131. constructor Create; override;
  132. destructor Destroy; override;
  133. //In Windows, this writes a checksum into a buffer. In Linux, it would probably
  134. //simply have the kernal write the checksum with something like this (RFC 2292):
  135. //
  136. // int offset = 2;
  137. // setsockopt(fd, IPPROTO_IPV6, IPV6_CHECKSUM, &offset, sizeof(offset));
  138. //
  139. // Note that this should be called
  140. //IMMEDIATELY before you do a SendTo because the Local IPv6 address might change
  141. procedure WriteChecksum(s : TIdStackSocketHandle;
  142. var VBuffer : TIdBytes;
  143. const AOffset : Integer;
  144. const AIP : String;
  145. const APort : TIdPort;
  146. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
  147. function IOControl(const s: TIdStackSocketHandle; const cmd: UInt32;
  148. var arg: UInt32): Integer; override;
  149. procedure GetLocalAddressList(AAddresses: TIdStackLocalAddressList); override;
  150. end;
  151. TLinger = record
  152. l_onoff: UInt16;
  153. l_linger: UInt16;
  154. end;
  155. TIdLinger = TLinger;
  156. implementation
  157. uses
  158. IdResourceStrings,
  159. IdException,
  160. SysUtils;
  161. type
  162. psockaddr_in6 = ^sockaddr_in6;
  163. const
  164. Id_MSG_NOSIGNAL = MSG_NOSIGNAL;
  165. Id_WSAEPIPE = EPIPE;
  166. constructor TIdStackLibc.Create;
  167. begin
  168. inherited Create;
  169. end;
  170. destructor TIdStackLibc.Destroy;
  171. begin
  172. inherited Destroy;
  173. end;
  174. function TIdStackLibc.GetLastError : Integer;
  175. begin
  176. Result := errno;
  177. end;
  178. procedure TIdStackLibc.SetLastError(Const AError : Integer);
  179. begin
  180. __errno_location^ := AError;
  181. end;
  182. procedure TIdStackLibc.WSSetLastError(const AErr : Integer);
  183. begin
  184. SetLastError(AErr);
  185. end;
  186. function TIdStackLibc.Accept(ASocket: TIdStackSocketHandle;
  187. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle;
  188. var
  189. LN: UInt32;
  190. LAddr: sockaddr_in6;
  191. begin
  192. LN := SizeOf(LAddr);
  193. Result := Libc.accept(ASocket, PSockAddr(@LAddr), @LN);
  194. if Result <> SOCKET_ERROR then begin
  195. case LAddr.sin6_family of
  196. Id_PF_INET4: begin
  197. with Psockaddr(@LAddr)^ do
  198. begin
  199. VIP := TranslateTInAddrToString(sin_addr, Id_IPv4);
  200. VPort := Ntohs(sin_port);
  201. end;
  202. VIPVersion := Id_IPV4;
  203. end;
  204. Id_PF_INET6: begin
  205. with LAddr do
  206. begin
  207. VIP := TranslateTInAddrToString(sin6_addr, Id_IPv6);
  208. VPort := ntohs(sin6_port);
  209. end;
  210. VIPVersion := Id_IPV6;
  211. end;
  212. else begin
  213. Libc.__close(Result);
  214. Result := Id_INVALID_SOCKET;
  215. IPVersionUnsupported;
  216. end;
  217. end;
  218. end else begin
  219. if GetLastError = EBADF then begin
  220. SetLastError(EINTR);
  221. end;
  222. end;
  223. end;
  224. procedure TIdStackLibc.Bind(ASocket: TIdStackSocketHandle;
  225. const AIP: string; const APort: TIdPort;
  226. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  227. var
  228. LAddr: sockaddr_in6;
  229. begin
  230. FillChar(LAddr, SizeOf(LAddr), 0);
  231. case AIPVersion of
  232. Id_IPv4: begin
  233. with Psockaddr(@LAddr)^ do
  234. begin
  235. sin_family := Id_PF_INET4;
  236. if AIP <> '' then begin
  237. TranslateStringToTInAddr(AIP, sin_addr, Id_IPv4);
  238. end;
  239. sin_port := htons(APort);
  240. end;
  241. CheckForSocketError(Libc.bind(ASocket, {$IFDEF LIBCPASS_STRUCT}PSockAddr(@LAddr)^ {$ELSE} Psockaddr(@LAddr) {$ENDIF},SizeOf(sockaddr)));
  242. end;
  243. Id_IPv6: begin
  244. with LAddr do
  245. begin
  246. sin6_family := Id_PF_INET6;
  247. if AIP <> '' then begin
  248. TranslateStringToTInAddr(AIP, sin6_addr, Id_IPv6);
  249. end;
  250. sin6_port := htons(APort);
  251. end;
  252. CheckForSocketError(Libc.bind(ASocket, {$IFDEF LIBCPASS_STRUCT}Psockaddr(@LAddr)^ {$ELSE}Psockaddr(@LAddr){$ENDIF}, SizeOf(sockaddr_in6)));
  253. end;
  254. else begin
  255. IPVersionUnsupported;
  256. end;
  257. end;
  258. end;
  259. function TIdStackLibc.WSCloseSocket(ASocket: TIdStackSocketHandle): Integer;
  260. begin
  261. Result := Libc.__close(ASocket);
  262. end;
  263. procedure TIdStackLibc.Connect(const ASocket: TIdStackSocketHandle;
  264. const AIP: string; const APort: TIdPort;
  265. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  266. var
  267. LAddr: sockAddr_in6;
  268. begin
  269. FillChar(LAddr, SizeOf(LAddr), 0);
  270. case AIPVersion of
  271. Id_IPv4: begin
  272. with Psockaddr(@LAddr)^ do
  273. begin
  274. sin_family := Id_PF_INET4;
  275. TranslateStringToTInAddr(AIP, sin_addr, Id_IPv4);
  276. sin_port := htons(APort);
  277. end;
  278. CheckForSocketError(Libc.connect(
  279. ASocket,
  280. {$IFDEF LIBCPASS_STRUCT}PSockAddr(@LAddr)^{$ELSE}Psockaddr(@LAddr){$ENDIF},
  281. SizeOf(sockaddr)));
  282. end;
  283. Id_IPv6: begin
  284. with LAddr do
  285. begin
  286. sin6_family := Id_PF_INET6;
  287. TranslateStringToTInAddr(AIP, sin6_addr, Id_IPv6);
  288. sin6_port := htons(APort);
  289. end;
  290. CheckForSocketError(Libc.connect(
  291. ASocket,
  292. {$IFDEF LIBCPASS_STRUCT}Psockaddr(@LAddr)^{$ELSE}Psockaddr(@LAddr){$ENDIF},
  293. SizeOf(sockaddr_in6)));
  294. end;
  295. else begin
  296. IPVersionUnsupported;
  297. end;
  298. end;
  299. end;
  300. function TIdStackLibc.HostByName(const AHostName: string;
  301. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
  302. var
  303. Lpa: PAnsiChar;
  304. Lsa: TInAddr;
  305. LHost: PHostEnt;
  306. // ipv6
  307. LHints: TAddressInfo;
  308. {$IFDEF LIBCPASS_STRUCT}
  309. LAddrInfo: PAddressInfo;
  310. {$ELSE}
  311. LAddrInfo: PAddrInfo;
  312. {$ENDIF}
  313. LRetVal: Integer;
  314. LAStr: AnsiString;
  315. begin
  316. case AIPVersion of
  317. Id_IPv4: begin
  318. LAStr := AnsiString(AHostName); // explicit convert to Ansi
  319. // TODO: use getaddrinfo() instead for IPv4 as well...
  320. LHost := Libc.gethostbyname(PAnsiChar(LAStr));
  321. if LHost <> nil then begin
  322. // TODO: gethostbynaame() might return other things besides IPv4
  323. // addresses, so we should be validating the address type before
  324. // attempting the conversion...
  325. Lpa := LHost^.h_addr_list^;
  326. Lsa.S_un_b.s_b1 := Ord(Lpa[0]);
  327. Lsa.S_un_b.s_b2 := Ord(Lpa[1]);
  328. Lsa.S_un_b.s_b3 := Ord(Lpa[2]);
  329. Lsa.S_un_b.s_b4 := Ord(Lpa[3]);
  330. Result := TranslateTInAddrToString(Lsa, Id_IPv4);
  331. end else begin
  332. //RaiseSocketError(h_errno);
  333. RaiseLastSocketError;
  334. end;
  335. end;
  336. Id_IPv6: begin
  337. FillChar(LHints, SizeOf(LHints), 0);
  338. LHints.ai_family := IdIPFamily[AIPVersion];
  339. LHints.ai_socktype := Integer(SOCK_STREAM);
  340. LAddrInfo := nil;
  341. LAStr := AnsiString(AHostName); // explicit convert to Ansi
  342. LRetVal := getaddrinfo(PAnsiChar(LAStr), nil, @LHints, {$IFDEF LIBCPASS_STRUCT}LAddrInfo{$ELSE}@LAddrInfo{$ENDIF});
  343. if LRetVal <> 0 then begin
  344. if LRetVal = EAI_SYSTEM then begin
  345. IndyRaiseLastError;
  346. end else begin
  347. raise EIdResolveError.CreateFmt(RSResolveError, [AHostName, gai_strerror(LRetVal), LRetVal]);
  348. end;
  349. end;
  350. try
  351. Result := TranslateTInAddrToString(LAddrInfo^.ai_addr^.sin_zero, Id_IPv6);
  352. finally
  353. freeaddrinfo(LAddrInfo);
  354. end;
  355. end
  356. else
  357. Result := ''; // avoid warning
  358. IPVersionUnsupported;
  359. end;
  360. end;
  361. function TIdStackLibc.ReadHostName: string;
  362. var
  363. LStr: array[0..250] of AnsiChar;
  364. begin
  365. if Libc.gethostname(LStr, 250) <> -1 then begin
  366. LStr[250] := #0;
  367. Result := String(LStr);
  368. end else begin
  369. Result := '';
  370. end;
  371. end;
  372. procedure TIdStackLibc.Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer);
  373. begin
  374. CheckForSocketError(Libc.listen(ASocket, ABacklog));
  375. end;
  376. function TIdStackLibc.WSRecv(ASocket: TIdStackSocketHandle; var ABuffer;
  377. const ABufferLength, AFlags: Integer): Integer;
  378. begin
  379. //IdStackWindows is just: Result := Recv(ASocket, ABuffer, ABufferLength, AFlags);
  380. Result := Recv(ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL);
  381. end;
  382. function TIdStackLibc.RecvFrom(const ASocket: TIdStackSocketHandle;
  383. var VBuffer; const ALength, AFlags: Integer; var VIP: string;
  384. var VPort: TIdPort; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION ): Integer;
  385. var
  386. LiSize: UInt32;
  387. LAddr: sockaddr_in6;
  388. begin
  389. case AIPVersion of
  390. Id_IPv4,
  391. Id_IPv6: begin
  392. if AIPVersion = Id_IPv4 then begin
  393. LiSize := SizeOf(sockaddr);
  394. end else begin
  395. LiSize := SizeOf(sockaddr_in6);
  396. end;
  397. Result := Libc.recvfrom(ASocket, VBuffer, ALength, AFlags or Id_MSG_NOSIGNAL, PSockAddr(@LAddr), @LiSize);
  398. if AIPVersion = Id_IPv4 then begin
  399. with Psockaddr(@LAddr)^ do begin
  400. VIP := TranslateTInAddrToString(sin_addr, Id_IPv4);
  401. VPort := ntohs(sin_port);
  402. end;
  403. end else begin
  404. with LAddr do begin
  405. VIP := TranslateTInAddrToString(sin6_addr, Id_IPv6);
  406. VPort := ntohs(sin6_port);
  407. end;
  408. end;
  409. end;
  410. else begin
  411. Result := 0;
  412. IPVersionUnsupported;
  413. end;
  414. end;
  415. end;
  416. function TIdStackLibc.ReceiveMsg(ASocket: TIdStackSocketHandle;
  417. var VBuffer: TIdBytes; APkt: TIdPacketInfo): UInt32;
  418. {var
  419. LIP : String;
  420. LPort : TIdPort;
  421. LSize: UInt32;
  422. LAddr: SockAddr_In6;
  423. LMsg : msghdr;
  424. LMsgBuf : BUF;
  425. LControl : TIdBytes;
  426. LCurCmsg : CMSGHDR; //for iterating through the control buffer
  427. LCurPt : Pin_pktinfo;
  428. LCurPt6 : Pin6_pktinfo;
  429. LByte : PByte;
  430. LDummy, LDummy2 : UInt32;
  431. begin
  432. //we call the macro twice because we specified two possible structures.
  433. //Id_IPV6_HOPLIMIT and Id_IPV6_PKTINFO
  434. LSize := CMSG_LEN(CMSG_LEN(Length(VBuffer)));
  435. SetLength( LControl,LSize);
  436. LMsgBuf.len := Length(VBuffer); // Length(VMsgData);
  437. LMsgBuf.buf := @VBuffer[0]; // @VMsgData[0];
  438. FillChar(LMsg,SizeOf(LMsg),0);
  439. LMsg.lpBuffers := @LMsgBuf;
  440. LMsg.dwBufferCount := 1;
  441. LMsg.Control.Len := LSize;
  442. LMsg.Control.buf := @LControl[0];
  443. LMsg.name := PSOCKADDR(@LAddr);
  444. LMsg.namelen := SizeOf(LAddr);
  445. CheckForSocketError(RecvMsg(ASocket, @LMsg, Result, @LDummy, LPwsaoverlapped_COMPLETION_ROUTINE(@LDummy2)));
  446. APkt.Reset;
  447. case LAddr.sin6_family of
  448. Id_PF_INET4: begin
  449. with PSOCKADDR(@LAddr)^ do
  450. begin
  451. APkt.SourceIP := TranslateTInAddrToString(sin_addr, Id_IPv4);
  452. APkt.SourcePort := NToHs(sin_port);
  453. end;
  454. APkt.SourceIPVersion := Id_IPv4;
  455. end;
  456. Id_PF_INET6: begin
  457. with LAddr do
  458. begin
  459. APkt.SourceIP := TranslateTInAddrToString(sin6_addr, Id_IPv6);
  460. APkt.SourcePort := NToHs(sin6_port);
  461. end;
  462. APkt.SourceIPVersion := Id_IPv6;
  463. end;
  464. else begin
  465. Result := 0; // avoid warning
  466. IPVersionUnsupported;
  467. end;
  468. end;
  469. LCurCmsg := nil;
  470. repeat
  471. LCurCmsg := CMSG_NXTHDR(@LMsg,LCurCmsg);
  472. if LCurCmsg=nil then
  473. begin
  474. break;
  475. end;
  476. case LCurCmsg^.cmsg_type of
  477. IP_PKTINFO : //done this way because IPV6_PKTINF and IP_PKTINFO are both 19
  478. begin
  479. case LAddr.sin6_family of
  480. Id_PF_INET4:
  481. begin
  482. LCurPt := WSA_CMSG_DATA(LCurCmsg);
  483. APkt.DestIP := GWindowsStack.TranslateTInAddrToString(LCurPt^.ipi_addr,Id_IPv4);
  484. APkt.DestIF := LCurPt^.ipi_ifindex;
  485. APkt.DestIPVersion := Id_IPv4;
  486. end;
  487. Id_PF_INET6:
  488. begin
  489. LCurPt6 := WSA_CMSG_DATA(LCurCmsg);
  490. APkt.DestIP := GWindowsStack.TranslateTInAddrToString(LCurPt6^.ipi6_addr,Id_IPv6);
  491. APkt.DestIF := LCurPt6^.ipi6_ifindex;
  492. APkt.DestIPVersion := Id_IPv6;
  493. end;
  494. end;
  495. end;
  496. Id_IPV6_HOPLIMIT :
  497. begin
  498. LByte := PByte(WSA_CMSG_DATA(LCurCmsg));
  499. APkt.TTL := LByte^;
  500. end;
  501. end;
  502. until False; }
  503. begin
  504. APkt.Reset;
  505. Result := 0; // avoid warning
  506. end;
  507. function TIdStackLibc.WSSend(ASocket: TIdStackSocketHandle;
  508. const ABuffer; const ABufferLength, AFlags: Integer): Integer;
  509. begin
  510. //CC: Should Id_MSG_NOSIGNAL be included?
  511. // Result := Send(ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL);
  512. Result := CheckForSocketError(Libc.send(ASocket, ABuffer, ABufferLength, AFlags));
  513. end;
  514. procedure TIdStackLibc.WSSendTo(ASocket: TIdStackSocketHandle;
  515. const ABuffer; const ABufferLength, AFlags: Integer; const AIP: string;
  516. const APort: TIdPort; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
  517. var
  518. LAddr: sockaddr_in6;
  519. LiSize, LBytesOut: Integer;
  520. begin
  521. case AIPVersion of
  522. Id_IPv4, Id_IPv6:
  523. begin
  524. FillChar(LAddr, SizeOf(LAddr), 0);
  525. if AIPVersion = Id_IPv4 then begin
  526. with PsockAddr(@LAddr)^ do begin
  527. sin_family := Id_PF_INET4;
  528. TranslateStringToTInAddr(AIP, sin_addr, Id_IPV4);
  529. sin_port := htons(APort);
  530. end;
  531. LiSize := SizeOf(sockaddr);
  532. end else begin
  533. with LAddr do begin
  534. sin6_family := Id_PF_INET6;
  535. TranslateStringToTInAddr(AIP, sin6_addr, AIPVersion);
  536. sin6_port := htons(APort);
  537. end;
  538. LiSize := SizeOf(sockaddr_in6);
  539. end;
  540. LBytesOut := Libc.sendto(
  541. ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL,
  542. {$IFDEF LIBCPASS_STRUCT}Psockaddr(@LAddr)^{$ELSE}Psockaddr(@LAddr){$ENDIF},
  543. LiSize);
  544. end;
  545. else begin
  546. LBytesOut := 0; // avoid warning
  547. IPVersionUnsupported;
  548. end;
  549. end;
  550. if LBytesOut = Id_SOCKET_ERROR then begin
  551. // TODO: move this into RaiseLastSocketError directly
  552. if WSGetLastError() = Id_WSAEMSGSIZE then begin
  553. raise EIdPackageSizeTooBig.Create(RSPackageSizeTooBig);
  554. end else begin
  555. RaiseLastSocketError;
  556. end;
  557. end else if LBytesOut <> ABufferLength then begin
  558. raise EIdNotAllBytesSent.Create(RSNotAllBytesSent);
  559. end;
  560. end;
  561. procedure TIdStackLibc.{$IFDEF DCC_XE3_OR_ABOVE}GetSocketOption{$ELSE}WSGetSocketOption{$ENDIF}
  562. (ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption;
  563. var AOptVal; var AOptLen: Integer);
  564. var
  565. LLen: UInt32;
  566. begin
  567. LLen := AOptLen;
  568. CheckForSocketError(Libc.getsockopt(ASocket, ALevel, AOptName, PIdAnsiChar(@AOptVal), LLen));
  569. AOptLen := LLen;
  570. end;
  571. procedure TIdStackLibc.{$IFDEF DCC_XE3_OR_ABOVE}SetSocketOption{$ELSE}WSSetSocketOption{$ENDIF}
  572. (ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption;
  573. const AOptVal; const AOptLen: Integer);
  574. begin
  575. CheckForSocketError(Libc.setsockopt(ASocket, ALevel, AOptName, PIdAnsiChar(@AOptVal), AOptLen));
  576. end;
  577. function TIdStackLibc.WSGetLastError: Integer;
  578. begin
  579. //IdStackWindows just uses result := WSAGetLastError;
  580. Result := GetLastError; //System.GetLastOSError; - FPC doesn't define it in System
  581. if Result = Id_WSAEPIPE then begin
  582. Result := Id_WSAECONNRESET;
  583. end;
  584. end;
  585. function TIdStackLibc.WSSocket(AFamily : Integer; AStruct : TIdSocketType; AProtocol: Integer;
  586. const ANonBlocking: Boolean = False): TIdStackSocketHandle; override;
  587. begin
  588. Result := Libc.socket(AFamily, AStruct or iif(ANonBlocking, SOCK_NONBLOCK, 0), AProtocol);
  589. end;
  590. function TIdStackLibc.WSGetServByName(const AServiceName: string): TIdPort;
  591. var
  592. Lps: PServEnt;
  593. LAStr: AnsiString;
  594. begin
  595. LAStr := AnsiString(AServiceName); // explicit convert to Ansi
  596. Lps := Libc.getservbyname(PAnsiChar(LAStr), nil);
  597. if Lps <> nil then begin
  598. Result := ntohs(Lps^.s_port);
  599. end else begin
  600. try
  601. Result := IndyStrToInt(AServiceName);
  602. except
  603. on EConvertError do begin
  604. IndyRaiseOuterException(EIdInvalidServiceName.CreateFmt(RSInvalidServiceName, [AServiceName]));
  605. end;
  606. end;
  607. end;
  608. end;
  609. function TIdStackLibc.WSGetServByPort(const APortNumber: TIdPort): TStrings;
  610. type
  611. PPAnsiCharArray = ^TPAnsiCharArray;
  612. TPAnsiCharArray = packed array[0..(Maxint div SizeOf(PAnsiChar))-1] of PAnsiChar;
  613. var
  614. Lps: PServEnt;
  615. Li: Integer;
  616. Lp: PPAnsiCharArray;
  617. begin
  618. Result := TStringList.Create;
  619. try
  620. Lps := Libc.getservbyport(htons(APortNumber), nil);
  621. if Lps <> nil then begin
  622. Result.Add(String(Lps^.s_name));
  623. Li := 0;
  624. Lp := Pointer(Lps^.s_aliases);
  625. while Lp[Li] <> nil do begin
  626. Result.Add(String(Lp[Li]));
  627. Inc(Li);
  628. end;
  629. end;
  630. except
  631. Result.Free;
  632. raise;
  633. end;
  634. end;
  635. function TIdStackLibc.HostToNetwork(AValue: UInt16): UInt16;
  636. begin
  637. Result := htons(AValue);
  638. end;
  639. function TIdStackLibc.NetworkToHost(AValue: UInt16): UInt16;
  640. begin
  641. Result := ntohs(AValue);
  642. end;
  643. function TIdStackLibc.HostToNetwork(AValue: UInt32): UInt32;
  644. begin
  645. Result := htonl(AValue);
  646. end;
  647. function TIdStackLibc.NetworkToHost(AValue: UInt32): UInt32;
  648. begin
  649. Result := ntohl(AValue);
  650. end;
  651. { RP - I'm not sure what endian Linux natively uses, thus the
  652. check to see if the bytes need swapping or not ... }
  653. function TIdStackLibc.HostToNetwork(AValue: UInt64): UInt64;
  654. var
  655. LParts: TIdUInt64Parts;//TIdUInt64Words
  656. L: UInt32;
  657. begin
  658. // TODO: enable this?
  659. (*
  660. LParts.LongWords[0] := htonl(UInt32(AValue shr 32));
  661. LParts.LongWords[1] := htonl(UInt32(AValue));
  662. Result := LParts.QuadPart;
  663. *)
  664. if (htonl(1) <> 1) then begin
  665. LParts.QuadPart := AValue;
  666. L := htonl(LParts.HighPart);
  667. LParts.HighPart := htonl(LParts.LowPart);
  668. LParts.LowPart := L;
  669. Result := LParts.QuadPart;
  670. end else begin
  671. Result := AValue;
  672. end;
  673. end;
  674. function TIdStackLibc.NetworkToHost(AValue: UInt64): UInt64;
  675. var
  676. LParts: TIdUInt64Parts;//TIdUInt64Words
  677. L: UInt32;
  678. begin
  679. // TODO: enable this?
  680. (*
  681. LParts.QuadPart := AValue;
  682. Result := (UInt64(ntohl(LParts.LongWords[0])) shl 32) or UInt64(ntohl(LParts.LongWords[1]));
  683. *)
  684. if (ntohl(1) <> 1) then begin
  685. LParts.QuadPart := AValue;
  686. L := ntohl(LParts.HighPart);
  687. LParts.HighPart := ntohl(LParts.LowPart);
  688. LParts.LowPart := L;
  689. Result := LParts.QuadPart;
  690. end else begin
  691. Result := AValue;
  692. end;
  693. end;
  694. {$IFDEF HAS_getifaddrs}
  695. type
  696. TIdStackLocalAddressAccess = class(TIdStackLocalAddress)
  697. end;
  698. {$ENDIF}
  699. procedure TIdStackLibc.GetLocalAddressList(AAddresses: TIdStackLocalAddressList);
  700. {$IFNDEF HAS_getifaddrs}
  701. type
  702. TaPInAddr = array[0..250] of PInAddr;
  703. PaPInAddr = ^TaPInAddr;
  704. TaPIn6Addr = array[0..250] of PIn6Addr;
  705. PaPIn6Addr = ^TaPIn6Addr;
  706. {$ENDIF}
  707. var
  708. {$IFDEF HAS_getifaddrs}
  709. LAddrList, LAddrInfo: pifaddrs;
  710. LSubNetStr, LBroadcastStr: string;
  711. LAddress: TIdStackLocalAddress;
  712. LName: string;
  713. {$ELSE}
  714. Li: Integer;
  715. LAHost: PHostEnt;
  716. LPAdrPtr: PaPInAddr;
  717. LPAdr6Ptr: PaPIn6Addr;
  718. LHostName: AnsiString;
  719. {$ENDIF}
  720. begin
  721. // TODO: Using gethostname() and gethostbyname() like this may not always
  722. // return just the machine's IP addresses. Technically speaking, they will
  723. // return the local hostname, and then return the address(es) to which that
  724. // hostname resolves. It is possible for a machine to (a) be configured such
  725. // that its name does not resolve to an IP, or (b) be configured such that
  726. // its name resolves to multiple IPs, only one of which belongs to the local
  727. // machine. For better results, we should use getifaddrs() on platforms that
  728. // support it...
  729. {$IFDEF HAS_getifaddrs}
  730. if getifaddrs(@LAddrList) = 0 then // TODO: raise an exception if it fails
  731. try
  732. AAddresses.BeginUpdate;
  733. try
  734. LAddrInfo := LAddrList;
  735. repeat
  736. if ((LAddrInfo^.ifa_flags and IFF_LOOPBACK) = 0) and (LAddrInfo^.ifa_addr <> nil) then
  737. begin
  738. LAddress := nil;
  739. case LAddrInfo^.ifa_addr^.sa_family of
  740. Id_PF_INET4: begin
  741. if LAddrInfo^.ifa_netmask <> nil then begin
  742. LSubNetStr := TranslateTInAddrToString(PSockAddr_In(LAddrInfo^.ifa_netmask)^.sin_addr, Id_IPv4);
  743. end else begin
  744. LSubNetStr := '';
  745. end;
  746. if ((LAddrInfo^.ifa_flags and IFF_BROADCAST) <> 0) and (LAddrInfo^.ifa_broadaddr <> nil) then
  747. LBroadcastStr := TranslateTInAddrToString(PSockAddr_In(LAddrInfo^.ifa_broadaddr)^.sin_addr, Id_IPv4);
  748. end else begin
  749. LBroadcastStr := '';
  750. end;
  751. LAddress := TIdStackLocalAddressIPv4.Create(AAddresses, TranslateTInAddrToString(PSockAddr_In(LAddrInfo^.ifa_addr)^.sin_addr, Id_IPv4), LSubNetStr, LBroadcastStr);
  752. end;
  753. Id_PF_INET6: begin
  754. LAddress := TIdStackLocalAddressIPv6.Create(AAddresses, TranslateTInAddrToString(PSockAddr_In6(LAddrInfo^.ifa_addr)^.sin6_addr, Id_IPv6));
  755. end;
  756. end;
  757. if LAddress <> nil then begin
  758. LName := LAddrInfo^.ifa_name;
  759. {$I IdObjectChecksOff.inc}
  760. TIdStackLocalAddressAccess(LAddress).FDescription := LName;
  761. TIdStackLocalAddressAccess(LAddress).FFriendlyName := LName;
  762. TIdStackLocalAddressAccess(LAddress).FInterfaceName := LName;
  763. {$IFDEF HAS_if_nametoindex}
  764. TIdStackLocalAddressAccess(LAddress).FInterfaceIndex := if_nametoindex(LAddrInfo^.ifa_name);
  765. {$ENDIF}
  766. {$I IdObjectChecksOn.inc}
  767. end;
  768. end;
  769. LAddrInfo := LAddrInfo^.ifa_next;
  770. until LAddrInfo = nil;
  771. finally
  772. AAddresses.EndUpdate;
  773. end;
  774. finally
  775. freeifaddrs(LAddrList);
  776. end;
  777. {$ELSE}
  778. // this won't get IPv6 addresses as I didn't find a way
  779. // to enumerate IPv6 addresses on a linux machine
  780. LHostName := AnsiString(HostName);
  781. LAHost := Libc.gethostbyname(PAnsiChar(LHostName));
  782. if LAHost = nil then begin
  783. RaiseLastSocketError;
  784. end;
  785. // gethostbyname() might return other things besides IPv4 addresses, so we
  786. // need to validate the address type before attempting the conversion...
  787. case LAHost^.h_addrtype of
  788. Id_PF_INET4: begin
  789. LPAdrPtr := PAPInAddr(LAHost^.h_addr_list);
  790. Li := 0;
  791. if LPAdrPtr^[Li] <> nil then begin
  792. AAddresses.BeginUpdate;
  793. try
  794. repeat
  795. TIdStackLocalAddressIPv4.Create(Addresses, TranslateTInAddrToString(LPAdrPtr^[Li]^, Id_IPv4), '', ''); // TODO: SubNetMask and BroadcastIP
  796. Inc(Li);
  797. until LPAdrPtr^[Li] = nil;
  798. finally
  799. AAddresses.EndUpdate;
  800. end;
  801. end;
  802. end;
  803. Id_PF_INET6: begin
  804. LPAdr6Ptr := PAPIn6Addr(LAHost^.h_addr_list);
  805. Li := 0;
  806. if LPAdr6Ptr^[Li] <> nil then begin
  807. AAddresses.BeginUpdate;
  808. try
  809. repeat
  810. TIdStackLocalAddressIPv6.Create(Addresses, TranslateTInAddrToString(LPAdr6Ptr^[Li]^, Id_IPv6));
  811. Inc(Li);
  812. until LPAdr6Ptr^[Li] = nil;
  813. finally
  814. AAddresses.EndUpdate;
  815. end;
  816. end;
  817. end;
  818. end;
  819. {$ENDIF}
  820. end;
  821. function TIdStackLibc.HostByAddress(const AAddress: string;
  822. const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
  823. var
  824. LAddr: sockaddr_in6;
  825. LSize: UInt32;
  826. LHostName : array[0..NI_MAXHOST] of TIdAnsiChar;
  827. {$IFDEF USE_MARSHALLED_PTRS}
  828. LHostNamePtr: TPtrWrapper;
  829. {$ENDIF}
  830. LRet : Integer;
  831. {$IFDEF LIBCPASS_STRUCT}
  832. LHints: TAddressInfo;
  833. LAddrInfo: PAddressInfo;
  834. {$ELSE}
  835. LHints: AddrInfo; //The T is no omission - that's what I found in the header
  836. LAddrInfo: PAddrInfo;
  837. {$ENDIF}
  838. begin
  839. FillChar(LAddr, SizeOf(LAddr), 0);
  840. case AIPVersion of
  841. Id_IPv4: begin
  842. with Psockaddr(@LAddr)^ do begin
  843. sin_family := Id_PF_INET4;
  844. TranslateStringToTInAddr(AAddress, sin_addr, Id_IPv4);
  845. end;
  846. LSize := SizeOf(sockaddr);
  847. end;
  848. Id_IPv6: begin
  849. with LAddr do begin
  850. sin6_family := Id_PF_INET6;
  851. TranslateStringToTInAddr(AAddress, sin6_addr, Id_IPv6);
  852. end;
  853. LSize := SizeOf(sockaddr_in6);
  854. end;
  855. else begin
  856. LSize := 0; // avoid warning
  857. IPVersionUnsupported;
  858. end;
  859. end;
  860. FillChar(LHostName[0],Length(LHostName),0);
  861. {$IFDEF USE_MARSHALLED_PTRS}
  862. LHostNamePtr := TPtrWrapper.Create(@LHostName[0]);
  863. {$ENDIF}
  864. LRet := getnameinfo(
  865. {$IFDEF LIBCPASS_STRUCT}Psockaddr(@LAddr)^{$ELSE}Psockaddr(@LAddr){$ENDIF},
  866. LSize,
  867. {$IFDEF USE_MARSHALLED_PTRS}
  868. LHostNamePtr.ToPointer
  869. {$ELSE}
  870. LHostName
  871. {$ENDIF},
  872. NI_MAXHOST,nil,0,NI_NAMEREQD );
  873. if LRet <> 0 then begin
  874. if LRet = EAI_SYSTEM then begin
  875. RaiseLastOSError;
  876. end else begin
  877. raise EIdReverseResolveError.CreateFmt(RSReverseResolveError, [AAddress, gai_strerror(LRet), LRet]);
  878. end;
  879. end;
  880. {
  881. IMPORTANT!!!
  882. getnameinfo can return either results from a numeric to text conversion or
  883. results from a DNS reverse lookup. Someone could make a malicous PTR record
  884. such as
  885. 1.0.0.127.in-addr.arpa. IN PTR 10.1.1.1
  886. and trick a caller into beleiving the socket address is 10.1.1.1 instead of
  887. 127.0.0.1. If there is a numeric host in LAddr, than this is the case and
  888. we disregard the result and raise an exception.
  889. }
  890. FillChar(LHints,SizeOf(LHints),0);
  891. LHints.ai_socktype := SOCK_DGRAM; //*dummy*/
  892. LHints.ai_flags := AI_NUMERICHOST;
  893. if getaddrinfo(
  894. {$IFDEF USE_MARSHALLED_PTRS}
  895. LHostNamePtr.ToPointer
  896. {$ELSE}
  897. LHostName
  898. {$ENDIF},
  899. '0', LHints, LAddrInfo) = 0 then
  900. begin
  901. freeaddrinfo(LAddrInfo^);
  902. Result := '';
  903. raise EIdMaliciousPtrRecord.Create(RSMaliciousPtrRecord);
  904. end;
  905. {$IFDEF USE_MARSHALLED_PTRS}
  906. Result := TMarshal.ReadStringAsAnsi(LHostNamePtr);
  907. {$ELSE}
  908. Result := String(LHostName);
  909. {$ENDIF}
  910. (* JMB: I left this in here just in case someone
  911. complains, but the other code works on all
  912. linux systems for all addresses and is thread-safe
  913. variables for it:
  914. Host: PHostEnt;
  915. LAddr: u_long;
  916. Id_IPv4: begin
  917. // GetHostByAddr is thread-safe in Linux.
  918. // It might not be safe in Solaris or BSD Unix
  919. LAddr := inet_addr(PAnsiChar(AAddress));
  920. Host := GetHostByAddr(@LAddr,SizeOf(LAddr),AF_INET);
  921. if (Host <> nil) then begin
  922. Result := Host^.h_name;
  923. end else begin
  924. RaiseSocketError(h_errno);
  925. end;
  926. end;
  927. *)
  928. end;
  929. function TIdStackLibc.WSShutdown(ASocket: TIdStackSocketHandle; AHow: Integer): Integer;
  930. begin
  931. Result := Libc.shutdown(ASocket, AHow);
  932. end;
  933. procedure TIdStackLibc.Disconnect(ASocket: TIdStackSocketHandle);
  934. begin
  935. // Windows uses Id_SD_Send, Linux should use Id_SD_Both
  936. WSShutdown(ASocket, Id_SD_Both);
  937. // SO_LINGER is false - socket may take a little while to actually close after this
  938. WSCloseSocket(ASocket);
  939. end;
  940. procedure TIdStackLibc.GetPeerName(ASocket: TIdStackSocketHandle;
  941. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion);
  942. var
  943. i: UInt32;
  944. LAddr: sockaddr_in6;
  945. begin
  946. i := SizeOf(LAddr);
  947. CheckForSocketError(Libc.getpeername(ASocket, Psockaddr(@LAddr)^, i));
  948. case LAddr.sin6_family of
  949. Id_PF_INET4: begin
  950. with Psockaddr(@LAddr)^ do
  951. begin
  952. VIP := TranslateTInAddrToString(sin_addr, Id_IPv4);
  953. VPort := ntohs(sin_port);
  954. end;
  955. VIPVersion := Id_IPV4;
  956. end;
  957. Id_PF_INET6: begin
  958. with LAddr do
  959. begin
  960. VIP := TranslateTInAddrToString(sin6_addr, Id_IPv6);
  961. VPort := Ntohs(sin6_port);
  962. end;
  963. VIPVersion := Id_IPV6;
  964. end;
  965. else begin
  966. IPVersionUnsupported;
  967. end;
  968. end;
  969. end;
  970. procedure TIdStackLibc.GetSocketName(ASocket: TIdStackSocketHandle;
  971. var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion);
  972. var
  973. i: UInt32;
  974. LAddr: sockaddr_in6;
  975. begin
  976. i := SizeOf(LAddr);
  977. CheckForSocketError(Libc.getsockname(ASocket, Psockaddr(@LAddr)^, i));
  978. case LAddr.sin6_family of
  979. Id_PF_INET4: begin
  980. with Psockaddr(@LAddr)^ do
  981. begin
  982. VIP := TranslateTInAddrToString(sin_addr, Id_IPv4);
  983. VPort := ntohs(sin_port);
  984. end;
  985. VIPVersion := Id_IPV4;
  986. end;
  987. Id_PF_INET6: begin
  988. with LAddr do
  989. begin
  990. VIP := TranslateTInAddrToString(sin6_addr, Id_IPv6);
  991. VPort := ntohs(sin6_port);
  992. end;
  993. VIPVersion := Id_IPV6;
  994. end;
  995. else begin
  996. IPVersionUnsupported;
  997. end;
  998. end;
  999. end;
  1000. function TIdStackLibc.WouldBlock(const AResult: Integer): Boolean;
  1001. begin
  1002. // using if-else instead of in..range because EAGAIN and EWOULDBLOCK
  1003. // have often the same value and so FPC might report a range error
  1004. Result := (AResult = Id_WSAEAGAIN) or
  1005. (AResult = Id_WSAEWOULDBLOCK) or
  1006. (AResult = Id_WSAEINPROGRESS);
  1007. end;
  1008. function TIdStackLibc.SupportsIPv4: Boolean;
  1009. begin
  1010. //In Windows, this does something else. It checks the LSP's installed.
  1011. Result := CheckIPVersionSupport(Id_IPv4);
  1012. end;
  1013. function TIdStackLibc.SupportsIPv6: Boolean;
  1014. begin
  1015. //In Windows, this does something else. It checks the LSP's installed.
  1016. Result := CheckIPVersionSupport(Id_IPv6);
  1017. end;
  1018. function TIdStackLibc.CheckIPVersionSupport(const AIPVersion: TIdIPVersion): Boolean;
  1019. var
  1020. LTmpSocket: TIdStackSocketHandle;
  1021. begin
  1022. // TODO: on nix systems (or maybe just Linux?), an alternative would be to
  1023. // check for the existance of the '/proc/net/if_inet6' kernel pseudo-file
  1024. LTmpSocket := WSSocket(IdIPFamily[AIPVersion], Integer(Id_SOCK_STREAM), Id_IPPROTO_IP );
  1025. Result := LTmpSocket <> Id_INVALID_SOCKET;
  1026. if Result then begin
  1027. WSCloseSocket(LTmpSocket);
  1028. end;
  1029. end;
  1030. procedure TIdStackLibc.WriteChecksum(s: TIdStackSocketHandle;
  1031. var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
  1032. const APort: TIdPort; const AIPVersion: TIdIPVersion);
  1033. begin
  1034. case AIPVersion of
  1035. Id_IPv4 : CopyTIdUInt16(HostToLittleEndian(CalcCheckSum(VBuffer)), VBuffer, AOffset);
  1036. Id_IPv6 : WriteChecksumIPv6(s, VBuffer, AOffset, AIP, APort);
  1037. else
  1038. IPVersionUnsupported;
  1039. end;
  1040. end;
  1041. procedure TIdStackLibc.WriteChecksumIPv6(s: TIdStackSocketHandle;
  1042. var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String;
  1043. const APort: TIdPort);
  1044. begin
  1045. //we simply request that the kernal write the checksum when the data
  1046. //is sent. All of the parameters required are because Windows is bonked
  1047. //because it doesn't have the IPV6CHECKSUM socket option meaning we have
  1048. //to querry the network interface in TIdStackWindows -- yuck!!
  1049. SetSocketOption(s, IPPROTO_IPV6, IPV6_CHECKSUM, AOffset);
  1050. end;
  1051. function TIdStackLibc.IOControl(const s: TIdStackSocketHandle;
  1052. const cmd: UInt32; var arg: UInt32): Integer;
  1053. begin
  1054. Result := ioctl(s, cmd, @arg);
  1055. end;
  1056. procedure TIdStackLibc.SetKeepAliveValues(ASocket: TIdStackSocketHandle;
  1057. const AEnabled: Boolean; const ATimeMS, AInterval: Integer);
  1058. begin
  1059. inherited; // turn SO_KEEPALIVE on/off first...
  1060. // TODO: remove below, as it should be handled by TIdStack.SetKeepAliveValues() now...
  1061. if AEnabled then begin
  1062. SetSocketOption(ASocket, Id_SOL_TCP, Id_TCP_KEEPIDLE, ATimeMS div MSecsPerSec);
  1063. SetSocketOption(ASocket, Id_SOL_TCP, Id_TCP_KEEPINTVL, AInterval div MSecsPerSec);
  1064. end;
  1065. end;
  1066. { TIdSocketListLibc }
  1067. type
  1068. TIdSocketListLibc = class (TIdSocketList)
  1069. protected
  1070. FCount: integer;
  1071. FFDSet: TFDSet;
  1072. //
  1073. class function FDSelect(AReadSet: PFDSet; AWriteSet: PFDSet; AExceptSet: PFDSet;
  1074. const ATimeout: Integer = IdTimeoutInfinite): integer;
  1075. function GetItem(AIndex: Integer): TIdStackSocketHandle; override;
  1076. public
  1077. procedure Add(AHandle: TIdStackSocketHandle); override;
  1078. procedure Remove(AHandle: TIdStackSocketHandle); override;
  1079. function Count: Integer; override;
  1080. procedure Clear; override;
  1081. function Clone: TIdSocketList; override;
  1082. function ContainsSocket(AHandle: TIdStackSocketHandle): boolean; override;
  1083. procedure GetFDSet(var VSet: TFDSet);
  1084. procedure SetFDSet(var VSet: TFDSet);
  1085. class function Select(AReadList: TIdSocketList; AWriteList: TIdSocketList;
  1086. AExceptList: TIdSocketList; const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  1087. function SelectRead(const ATimeout: Integer = IdTimeoutInfinite): Boolean;
  1088. override;
  1089. function SelectReadList(var VSocketList: TIdSocketList;
  1090. const ATimeout: Integer = IdTimeoutInfinite): Boolean; override;
  1091. End;//TIdSocketList
  1092. procedure TIdSocketListLibc.Add(AHandle: TIdStackSocketHandle);
  1093. begin
  1094. Lock;
  1095. try
  1096. if not FD_ISSET(AHandle, FFDSet) then begin
  1097. if AHandle >= __FD_SETSIZE then begin
  1098. raise EIdStackSetSizeExceeded.Create(RSSetSizeExceeded);
  1099. end;
  1100. FD_SET(AHandle, FFDSet);
  1101. Inc(FCount);
  1102. end;
  1103. finally
  1104. Unlock;
  1105. end;
  1106. end;//
  1107. procedure TIdSocketListLibc.Clear;
  1108. begin
  1109. Lock;
  1110. try
  1111. FD_ZERO(FFDSet);
  1112. FCount := 0;
  1113. finally
  1114. Unlock;
  1115. end;
  1116. end;
  1117. function TIdSocketListLibc.ContainsSocket(
  1118. AHandle: TIdStackSocketHandle): boolean;
  1119. begin
  1120. Lock;
  1121. try
  1122. Result := FD_ISSET(AHandle, FFDSet);
  1123. finally
  1124. Unlock;
  1125. end;
  1126. end;
  1127. function TIdSocketListLibc.Count: Integer;
  1128. begin
  1129. Lock;
  1130. try
  1131. Result := FCount;
  1132. finally
  1133. Unlock;
  1134. end;
  1135. end;//
  1136. class function TIdSocketListLibc.FDSelect(AReadSet, AWriteSet,
  1137. AExceptSet: PFDSet; const ATimeout: Integer): integer;
  1138. var
  1139. LTime: TTimeVal;
  1140. LTimePtr: PTimeVal;
  1141. begin
  1142. if ATimeout = IdTimeoutInfinite then begin
  1143. LTimePtr := nil;
  1144. end else begin
  1145. LTime.tv_sec := ATimeout div 1000;
  1146. LTime.tv_usec := (ATimeout mod 1000) * 1000;
  1147. LTimePtr := @LTime;
  1148. end;
  1149. // TODO: calculate the actual nfds value based on the Sets provided...
  1150. // TODO: use poll() instead of select() to remove limit on how many sockets can be queried
  1151. Result := Libc.select(__FD_SETSIZE, AReadSet, AWriteSet, AExceptSet, LTimePtr);
  1152. end;
  1153. procedure TIdSocketListLibc.GetFDSet(var VSet: TFDSet);
  1154. begin
  1155. Lock;
  1156. try
  1157. VSet := FFDSet;
  1158. finally
  1159. Unlock;
  1160. end;
  1161. end;
  1162. function TIdSocketListLibc.GetItem(AIndex: Integer): TIdStackSocketHandle;
  1163. var
  1164. LIndex, i: Integer;
  1165. begin
  1166. Result := 0;
  1167. Lock;
  1168. try
  1169. LIndex := 0;
  1170. //? use FMaxHandle div x
  1171. for i:= 0 to __FD_SETSIZE - 1 do begin
  1172. if FD_ISSET(i, FFDSet) then begin
  1173. if LIndex = AIndex then begin
  1174. Result := i;
  1175. Break;
  1176. end;
  1177. Inc(LIndex);
  1178. end;
  1179. end;
  1180. finally
  1181. Unlock;
  1182. end;
  1183. end;//
  1184. procedure TIdSocketListLibc.Remove(AHandle: TIdStackSocketHandle);
  1185. begin
  1186. Lock;
  1187. try
  1188. if FD_ISSET(AHandle, FFDSet) then begin
  1189. Dec(FCount);
  1190. FD_CLR(AHandle, FFDSet);
  1191. end;
  1192. finally
  1193. Unlock;
  1194. end;
  1195. end;//
  1196. function TIdStackLibc.WSTranslateSocketErrorMsg(const AErr: Integer): string;
  1197. begin
  1198. //we override this function for the herr constants that
  1199. //are returned by the DNS functions
  1200. case AErr of
  1201. Libc.HOST_NOT_FOUND: Result := RSStackHOST_NOT_FOUND;
  1202. Libc.TRY_AGAIN: Result := RSStackTRY_AGAIN;
  1203. Libc.NO_RECOVERY: Result := RSStackNO_RECOVERY;
  1204. Libc.NO_DATA: Result := RSStackNO_DATA;
  1205. else
  1206. Result := inherited WSTranslateSocketErrorMsg(AErr);
  1207. end;
  1208. end;
  1209. procedure TIdSocketListLibc.SetFDSet(var VSet: TFDSet);
  1210. begin
  1211. Lock;
  1212. try
  1213. FFDSet := VSet;
  1214. finally
  1215. Unlock;
  1216. end;
  1217. end;
  1218. class function TIdSocketListLibc.Select(AReadList: TIdSocketList; AWriteList: TIdSocketList;
  1219. AExceptList: TIdSocketList; const ATimeout: Integer = IdTimeoutInfinite): Boolean;
  1220. var
  1221. LReadSet: TFDSet;
  1222. LWriteSet: TFDSet;
  1223. LExceptSet: TFDSet;
  1224. LPReadSet: PFDSet;
  1225. LPWriteSet: PFDSet;
  1226. LPExceptSet: PFDSet;
  1227. procedure ReadSet(AList: TIdSocketList; var ASet: TFDSet; var APSet: PFDSet);
  1228. begin
  1229. if AList <> nil then begin
  1230. TIdSocketListLibc(AList).GetFDSet(ASet);
  1231. APSet := @ASet;
  1232. end else begin
  1233. APSet := nil;
  1234. end;
  1235. end;
  1236. begin
  1237. ReadSet(AReadList, LReadSet, LPReadSet);
  1238. ReadSet(AWriteList, LWriteSet, LPWriteSet);
  1239. ReadSet(AExceptList, LExceptSet, LPExceptSet);
  1240. //
  1241. Result := FDSelect(LPReadSet, LPWriteSet, LPExceptSet, ATimeout) >0;
  1242. //
  1243. if AReadList <> nil then begin
  1244. TIdSocketListLibc(AReadList).SetFDSet(LReadSet);
  1245. end;
  1246. if AWriteList <> nil then begin
  1247. TIdSocketListLibc(AWriteList).SetFDSet(LWriteSet);
  1248. end;
  1249. if AExceptList <> nil then begin
  1250. TIdSocketListLibc(AExceptList).SetFDSet(LExceptSet);
  1251. end;
  1252. end;
  1253. function TIdSocketListLibc.SelectRead(const ATimeout: Integer): Boolean;
  1254. var
  1255. LSet: TFDSet;
  1256. begin
  1257. Lock;
  1258. try
  1259. LSet := FFDSet;
  1260. // select() updates this structure on return,
  1261. // so we need to copy it each time we need it
  1262. finally
  1263. Unlock;
  1264. end;
  1265. Result := FDSelect(@LSet, nil, nil, ATimeout) > 0;
  1266. end;
  1267. function TIdSocketListLibc.SelectReadList(var VSocketList: TIdSocketList;
  1268. const ATimeout: Integer = IdTimeoutInfinite): Boolean;
  1269. var
  1270. LSet: TFDSet;
  1271. begin
  1272. Lock;
  1273. try
  1274. LSet := FFDSet;
  1275. // select() updates this structure on return,
  1276. // so we need to copy it each time we need it
  1277. finally
  1278. Unlock;
  1279. end;
  1280. Result := FDSelect(@LSet, nil, nil, ATimeout) > 0;
  1281. if Result then begin
  1282. if VSocketList = nil then begin
  1283. VSocketList := TIdSocketList.CreateSocketList;
  1284. end;
  1285. TIdSocketListLibc(VSocketList).SetFDSet(LSet);
  1286. end;
  1287. end;
  1288. procedure TIdStackLibc.SetBlocking(ASocket: TIdStackSocketHandle;
  1289. const ABlocking: Boolean);
  1290. var
  1291. LFlags: Integer;
  1292. //LValue: UInt32;
  1293. begin
  1294. LFlags := CheckForSocketError(Libc.fcntl(ASocket, F_GETFL, 0));
  1295. if ABlocking then begin
  1296. LFlags := LFlags and not O_NONBLOCK;
  1297. end else begin
  1298. LFlags := LFlags or O_NONBLOCK;
  1299. end;
  1300. CheckForSocketError(Libc.fcntl(ASocket, F_SETFL, LFlags));
  1301. {
  1302. LValue := UInt32(not ABlocking);
  1303. CheckForSocketError(Libc.ioctl(ASocket, FIONBIO, @LValue));
  1304. }
  1305. end;
  1306. (*
  1307. Why did I remove this again?
  1308. 1) it sends SIGPIPE even if the socket is created with the no-sigpipe bit set
  1309. that could be solved by blocking sigpipe within this thread
  1310. This is probably a bug in the Linux kernel, but we could work around it
  1311. by blocking that signal for the time of sending the file (just get the
  1312. sigprocmask, see if pipe bit is set, if not set it and remove again after
  1313. sending the file)
  1314. But the more serious reason is another one, which exists in Windows too:
  1315. 2) I think that ServeFile is misdesigned:
  1316. ServeFile does not raise an exception if it didn't send all the bytes.
  1317. Now what happens if I have OnExecute assigned like this
  1318. AThread.Connection.ServeFile('...', True); // <-- true to send via kernel
  1319. is that it will return 0, but notice that in this case I didn't ask for the
  1320. result. Net effect is that the thread will loop in OnExecute even if the
  1321. socket is long gone. This doesn't fit Indy semantics at all, exceptions are
  1322. always raised if the remote end disconnects. Even if I would do
  1323. AThread.Connection.ServeFile('...', False);
  1324. then it would raise an exception.
  1325. I think this is a big flaw in the design of the ServeFile function.
  1326. Maybe GServeFile should only return the bytes sent, but then
  1327. TCPConnection.ServeFile() should raise an exception if GServeFile didn't
  1328. send all the bytes.
  1329. JM Berg, 2002-09-09
  1330. function ServeFile(ASocket: TIdStackSocketHandle; AFileName: string): UInt32;
  1331. var
  1332. LFileHandle: integer;
  1333. offset: integer;
  1334. stat: _stat;
  1335. begin
  1336. LFileHandle := open(PAnsiChar(AFileName), O_RDONLY);
  1337. try
  1338. offset := 0;
  1339. fstat(LFileHandle, stat);
  1340. Result := sendfile(ASocket, LFileHandle, offset, stat.st_size);
  1341. //** if Result = UInt32(-1) then RaiseLastOSError;
  1342. finally libc.__close(LFileHandle); end;
  1343. end;
  1344. *)
  1345. function TIdSocketListLibc.Clone: TIdSocketList;
  1346. begin
  1347. Result := TIdSocketListLibc.Create;
  1348. try
  1349. Lock;
  1350. try
  1351. TIdSocketListLibc(Result).SetFDSet(FFDSet);
  1352. finally
  1353. Unlock;
  1354. end;
  1355. except
  1356. Result.Free;
  1357. raise;
  1358. end;
  1359. end;
  1360. initialization
  1361. GSocketListClass := TIdSocketListLibc;
  1362. end.