IdStackLinux.pas 45 KB

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