From 6fbd19546c235ee501373de6f8c72710a3bbddf0 Mon Sep 17 00:00:00 2001 From: wqmeng Date: Sun, 6 Sep 2026 18:11:35 +0800 Subject: [PATCH 1/4] feat(proxy): add proxy client demos and diagnostics MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 中文：增加命令行和标准 FMX 代理演示，覆盖 HTTP、HTTPS、SOCKS4、SOCKS5、IPv4、IPv6、DNS、WebSocket 及用户名密码认证；将代理握手和认证失败原因传递到 HTTP 上层，并完善 HTTP 407 与 SOCKS5 错误提示。提交仅包含源码和项目文件，不包含编译产物。 English: Add command-line and standard FMX proxy demos covering HTTP, HTTPS, SOCKS4, SOCKS5, IPv4, IPv6, DNS, WebSocket, and username/password authentication. Propagate proxy handshake and authentication failures to the HTTP layer and improve HTTP 407 and SOCKS5 diagnostics. Source and project files only; build artifacts are excluded. --- Net/Demos/Delphi/ProxyClient/ProxyClient.dpr | 307 +++++ .../Delphi/ProxyClient/ProxyClient.dproj | 29 + Net/Demos/Delphi/ProxyClient/README.md | 30 + .../ProxyClientGui/ProxyClientGui.Main.fmx | 171 +++ .../ProxyClientGui/ProxyClientGui.Main.pas | 245 ++++ .../Delphi/ProxyClientGui/ProxyClientGui.dpr | 13 + .../ProxyClientGui/ProxyClientGui.dproj | 1062 +++++++++++++++++ Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas | 232 ++++ Net/Demos/Delphi/ProxyClientGui/README.md | 21 + Net/Net.CrossHttpClient.pas | 130 +- Net/Net.CrossProxy.pas | 537 +++++++++ Net/Net.CrossSocket.Base.pas | 256 +++- Net/Net.CrossSocket.Epoll.pas | 26 +- Net/Net.CrossSocket.Iocp.pas | 28 +- Net/Net.CrossSocket.Kqueue.pas | 26 +- Net/Net.CrossSslSocket.Base.pas | 1 + Net/Net.CrossSslSocket.MbedTls.pas | 52 + Net/Net.CrossSslSocket.OpenSSL.pas | 458 ++++++- Net/Net.CrossWebSocketClient.pas | 12 + 19 files changed, 3542 insertions(+), 94 deletions(-) create mode 100644 Net/Demos/Delphi/ProxyClient/ProxyClient.dpr create mode 100644 Net/Demos/Delphi/ProxyClient/ProxyClient.dproj create mode 100644 Net/Demos/Delphi/ProxyClient/README.md create mode 100644 Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.fmx create mode 100644 Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.pas create mode 100644 Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dpr create mode 100644 Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dproj create mode 100644 Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas create mode 100644 Net/Demos/Delphi/ProxyClientGui/README.md create mode 100644 Net/Net.CrossProxy.pas diff --git a/Net/Demos/Delphi/ProxyClient/ProxyClient.dpr b/Net/Demos/Delphi/ProxyClient/ProxyClient.dpr new file mode 100644 index 0000000..fcb7ddc --- /dev/null +++ b/Net/Demos/Delphi/ProxyClient/ProxyClient.dpr @@ -0,0 +1,307 @@ +program ProxyClient; + +{$APPTYPE CONSOLE} +{$I zLib.inc} + +uses + SysUtils, + Classes, + Net.CrossSocket.Base, + Net.CrossProxy, + Net.CrossHttpClient, + Net.CrossHttpParams, + Net.CrossWebSocketClient, + Net.CrossWebSocketParser, + Net.SocketAPI, + Net.Winsock2, + Winapi.Windows, + Net.OpenSSL, + Utils.Utils; + +function ProxyTypeOf(const AValue: string): TCrossProxyType; +begin + if SameText(AValue, 'http') then Exit(cptHttp); + if SameText(AValue, 'https') then Exit(cptHttps); + if SameText(AValue, 'socks4') then Exit(cptSocks4); + if SameText(AValue, 'socks5') then Exit(cptSocks5); + Result := cptDirect; +end; + +procedure Usage; +begin + Writeln('ProxyClient [user] [password]'); + Writeln('Examples:'); + Writeln(' ProxyClient http socks5 127.0.0.1 10808'); + Writeln(' ProxyClient doh http 127.0.0.1 10809'); + Writeln(' ProxyClient ws socks5 127.0.0.1 10808'); + Writeln(' ProxyClient udp direct 0 0'); + Writeln('proxy-type: direct, http, https, socks4, socks5'); +end; + +function ReadSocketBytes(const ASocket: TSocket; var ABuffer; const ACount: Integer): Boolean; +var + LOffset, LCount: Integer; +begin + LOffset := 0; + while LOffset < ACount do + begin + LCount := TSocketAPI.Recv(ASocket, PByte(@ABuffer)[LOffset], ACount - LOffset); + if LCount <= 0 then + Exit(False); + Inc(LOffset, LCount); + end; + Result := True; +end; + +procedure SendSocketBytes(const ASocket: TSocket; const ABuffer; const ACount: Integer); +begin + if TSocketAPI.Send(ASocket, ABuffer, ACount) <> ACount then + raise Exception.Create('Short write during SOCKS5 UDP handshake'); +end; + +procedure TestSocks5Udp(const ASettings: TCrossProxySettings); +const + CQuery: array[0..31] of Byte = + ($CA, $FE, $01, $00, $00, $01, $00, $00, $00, $00, $00, $00, + $03, $77, $77, $77, $06, $67, $6F, $6F, $67, $6C, $65, $03, + $63, $6F, $6D, $00, $00, $01, $00, $01); +var + LHints: TRawAddrInfo; + LAddrInfo: PRawAddrInfo; + LTcpSocket, LUdpSocket: TSocket; + LGreeting: array[0..2] of Byte; + LAuth: TBytes; + LAssociate: array[0..9] of Byte; + LResponse: array[0..2047] of Byte; + LPacket: TBytes; + LRelayAddr: sockaddr_in; + LFromAddr: sockaddr; + LFromLen, LSent, LReceived, I: Integer; + LStarted: Cardinal; +begin + if ASettings.ProxyType <> cptSocks5 then + raise Exception.Create('SOCKS5 UDP ASSOCIATE requires proxy-type socks5'); + FillChar(LHints, SizeOf(LHints), 0); + LHints.ai_family := AF_INET; + LHints.ai_socktype := SOCK_STREAM; + LHints.ai_protocol := IPPROTO_TCP; + LAddrInfo := TSocketAPI.GetAddrInfo(ASettings.Host, ASettings.Port, LHints); + if LAddrInfo = nil then + raise Exception.Create('Unable to resolve SOCKS5 proxy'); + try + LTcpSocket := TSocketAPI.NewSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP); + if TSocketAPI.Connect(LTcpSocket, LAddrInfo.ai_addr, LAddrInfo.ai_addrlen) <> 0 then + raise Exception.Create('Unable to connect SOCKS5 proxy'); + try + TSocketAPI.SetRecvTimeout(LTcpSocket, 5000); + LGreeting[0] := $05; + LGreeting[1] := $01; // NMETHODS + LGreeting[2] := $00; // NO AUTHENTICATION REQUIRED + SendSocketBytes(LTcpSocket, LGreeting[0], SizeOf(LGreeting)); + LGreeting[0] := 0; + if not ReadSocketBytes(LTcpSocket, LGreeting[0], 2) or + (LGreeting[0] <> $05) then + raise Exception.CreateFmt('Invalid SOCKS5 method response (%x %x)', + [LGreeting[0], LGreeting[1]]); + if LGreeting[1] = $02 then + begin + if (Length(ASettings.Username) > 255) or (Length(ASettings.Password) > 255) then + raise Exception.Create('SOCKS5 credentials exceed 255 bytes'); + SetLength(LAuth, 3 + Length(ASettings.Username) + Length(ASettings.Password)); + LAuth[0] := $01; + LAuth[1] := Length(ASettings.Username); + if Length(ASettings.Username) > 0 then + Move(ASettings.Username[1], LAuth[2], Length(ASettings.Username)); + LAuth[2 + Length(ASettings.Username)] := Length(ASettings.Password); + if Length(ASettings.Password) > 0 then + Move(ASettings.Password[1], LAuth[3 + Length(ASettings.Username)], Length(ASettings.Password)); + SendSocketBytes(LTcpSocket, LAuth[0], Length(LAuth)); + if not ReadSocketBytes(LTcpSocket, LGreeting[0], 2) or + (LGreeting[0] <> $01) or (LGreeting[1] <> $00) then + raise Exception.Create('SOCKS5 username/password authentication failed'); + end + else if LGreeting[1] <> $00 then + raise Exception.CreateFmt('SOCKS5 method %d is not supported', [LGreeting[1]]); + FillChar(LAssociate, SizeOf(LAssociate), 0); + LAssociate[0] := $05; + LAssociate[1] := $03; // UDP ASSOCIATE + LAssociate[3] := $01; // IPv4, 0.0.0.0:0 + SendSocketBytes(LTcpSocket, LAssociate[0], SizeOf(LAssociate)); + if not ReadSocketBytes(LTcpSocket, LAssociate[0], 4) or + (LAssociate[1] <> $00) or (LAssociate[3] <> $01) then + raise Exception.Create('SOCKS5 UDP ASSOCIATE failed'); + if not ReadSocketBytes(LTcpSocket, LAssociate[4], 6) then + raise Exception.Create('Incomplete SOCKS5 UDP relay address'); + FillChar(LRelayAddr, SizeOf(LRelayAddr), 0); + LRelayAddr.sin_family := AF_INET; + Move(LAssociate[4], LRelayAddr.sin_addr, 4); + Move(LAssociate[8], LRelayAddr.sin_port, 2); + // Some local SOCKS listeners return 0.0.0.0 as the relay address. + // In that case the relay is reachable on the proxy endpoint itself. + if LRelayAddr.sin_addr.S_addr = 0 then + LRelayAddr.sin_addr.S_addr := PSockAddrIn(LAddrInfo.ai_addr)^.sin_addr.S_addr; + LUdpSocket := TSocketAPI.NewSocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP); + try + SetLength(LPacket, 4 + 4 + 2 + Length(CQuery)); + FillChar(LPacket[0], Length(LPacket), 0); + LPacket[2] := 0; // FRAG + LPacket[3] := 1; // IPv4 target + LPacket[4] := 1; LPacket[5] := 1; LPacket[6] := 1; LPacket[7] := 1; + LPacket[8] := 0; LPacket[9] := 53; + for I := 0 to High(CQuery) do LPacket[10 + I] := CQuery[I]; + LSent := TSocketAPI.SendTo(LUdpSocket, @LRelayAddr, SizeOf(LRelayAddr), LPacket[0], Length(LPacket)); + LFromLen := SizeOf(LFromAddr); + TSocketAPI.SetNonBlock(LUdpSocket, True); + LStarted := GetTickCount; + LReceived := -1; + while (LReceived <= 0) and (GetTickCount - LStarted < 5000) do + begin + LReceived := TSocketAPI.RecvFrom(LUdpSocket, @LFromAddr, LFromLen, + LResponse[0], Length(LResponse)); + if LReceived <= 0 then + Sleep(50); + end; + if (LSent = Length(LPacket)) and (LReceived > 12) and + (LResponse[0] = 0) and (LResponse[1] = 0) and + (LResponse[3] = 1) and (LResponse[10] = $CA) and (LResponse[11] = $FE) then + Writeln('SOCKS5 UDP DNS success') + else + Writeln('SOCKS5 UDP DNS failed (sent=', LSent, ', received=', LReceived, ')'); + finally + TSocketAPI.CloseSocket(LUdpSocket); + end; + finally + TSocketAPI.CloseSocket(LTcpSocket); + end; + finally + TSocketAPI.FreeAddrInfo(LAddrInfo); + end; +end; + +procedure TestUdp(const ASettings: TCrossProxySettings); +const + // DNS query: ID=CAFE, recursion desired, QNAME=www.google.com, QTYPE=A. + CQuery: array[0..31] of Byte = + ($CA, $FE, $01, $00, $00, $01, $00, $00, $00, $00, $00, $00, + $03, $77, $77, $77, $06, $67, $6F, $6F, $67, $6C, $65, $03, + $63, $6F, $6D, $00, $00, $01, $00, $01); +var + LHints: TRawAddrInfo; + LAddrInfo: PRawAddrInfo; + LSocket: TSocket; + LBuffer: array[0..2047] of Byte; + LSent, LReceived: Integer; +begin + if ASettings.ProxyType = cptSocks5 then + begin + TestSocks5Udp(ASettings); + Exit; + end; + FillChar(LHints, SizeOf(LHints), 0); + LHints.ai_family := AF_UNSPEC; + LHints.ai_socktype := SOCK_DGRAM; + LHints.ai_protocol := IPPROTO_UDP; + LAddrInfo := TSocketAPI.GetAddrInfo('8.8.8.8', 53, LHints); + if LAddrInfo = nil then + raise Exception.Create('Unable to resolve the UDP test endpoint'); + try + LSocket := TSocketAPI.NewSocket(LAddrInfo.ai_family, SOCK_DGRAM, IPPROTO_UDP); + if not TSocketAPI.IsValidSocket(LSocket) then + raise Exception.Create('Unable to create UDP socket'); + try + TSocketAPI.SetRecvTimeout(LSocket, 5000); + if TSocketAPI.Connect(LSocket, LAddrInfo.ai_addr, LAddrInfo.ai_addrlen) <> 0 then + raise Exception.Create('Unable to connect the UDP test socket'); + LSent := TSocketAPI.Send(LSocket, CQuery[0], Length(CQuery)); + LReceived := TSocketAPI.Recv(LSocket, LBuffer[0], Length(LBuffer)); + if (LSent = Length(CQuery)) and (LReceived >= 12) and + (LBuffer[0] = $CA) and (LBuffer[1] = $FE) then + Writeln('UDP DNS success via the local routing/proxy stack') + else + Writeln('UDP DNS failed (sent=', LSent, ', received=', LReceived, ')'); + finally + TSocketAPI.CloseSocket(LSocket); + end; + finally + TSocketAPI.FreeAddrInfo(LAddrInfo); + end; +end; + +function SettingsFromArgs: TCrossProxySettings; +var + LType: TCrossProxyType; +begin + LType := ProxyTypeOf(ParamStr(2)); + if LType = cptDirect then + Exit(TCrossProxySettings.Direct); + Result := TCrossProxySettings.Create(LType, ParamStr(3), StrToInt(ParamStr(4)), + ParamStr(5), ParamStr(6)); +end; + +procedure TestHttp(const ASettings: TCrossProxySettings; const AUrl: string); +var + LClient: ICrossHttpClient; +begin + LClient := TCrossHttpClient.Create; + LClient.ProxySettings := ASettings; + // This is a connectivity probe; certificate validation is outside this Demo's scope. + LClient.VerifyPeer := False; + Writeln('HTTP GET ', AUrl, ' via ', ParamStr(2)); + LClient.DoRequest('GET', AUrl, THttpHeader(nil), Pointer(nil), 0, TStream(nil), + procedure(const ARequest: ICrossHttpClientRequest) + begin + if SameText(ParamStr(1), 'doh') then + ARequest.Header['Accept'] := 'application/dns-json'; + end, + procedure(const AResponse: ICrossHttpClientResponse) + begin + if AResponse = nil then + Writeln('FAILED: no response') + else if AResponse.Content = nil then + Writeln('FAILED: ', AResponse.StatusCode, ' ', AResponse.StatusText) + else begin + Writeln(AResponse.StatusCode, ' ', AResponse.StatusText); + Writeln(TUtils.GetString(AResponse.Content)); + end; + end); + Readln; +end; + +procedure TestWebSocket(const ASettings: TCrossProxySettings); +var + LManager: TCrossWebSocketMgr; + LSocket: ICrossWebSocket; +begin + LManager := TCrossWebSocketMgr.Create; + LManager.ProxySettings := ASettings; + LSocket := LManager.CreateWebSocket('wss://ws.postman-echo.com/raw'); + LSocket.OnOpen(procedure begin Writeln('WebSocket OPEN'); LSocket.Send('cross-socket proxy demo'); end); + LSocket.OnMessage(procedure(const AType: TWsMessageType; const AData: TBytes) + begin Writeln('WebSocket MESSAGE: ', TUtils.GetString(AData)); end); + LSocket.OnClose(procedure begin Writeln('WebSocket CLOSE'); end); + LSocket.Open; +end; + +var + LSettings: TCrossProxySettings; +begin + CrossSocketLogEnabled := False; + if ParamCount < 4 then begin Usage; Exit; end; + try + LSettings := SettingsFromArgs; + if SameText(ParamStr(1), 'http') then + TestHttp(LSettings, 'https://www.google.com/') + else if SameText(ParamStr(1), 'doh') then + TestHttp(LSettings, 'https://cloudflare-dns.com/dns-query?name=www.google.com&type=A') + else if SameText(ParamStr(1), 'ws') then + TestWebSocket(LSettings) + else if SameText(ParamStr(1), 'udp') then + TestUdp(LSettings) + else begin Usage; Exit; end; + if not SameText(ParamStr(1), 'ws') then + Exit; + Readln; + except + on E: Exception do Writeln(E.ClassName, ': ', E.Message); + end; +end. diff --git a/Net/Demos/Delphi/ProxyClient/ProxyClient.dproj b/Net/Demos/Delphi/ProxyClient/ProxyClient.dproj new file mode 100644 index 0000000..5976805 --- /dev/null +++ b/Net/Demos/Delphi/ProxyClient/ProxyClient.dproj @@ -0,0 +1,29 @@ + + + {D8C7E2E5-42C8-4D2D-9A77-7B0F9C6D1D24} + ProxyClient.dpr + true + Debug + 1 + Console + None + Win32 + + + System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;Data.Win;Web.Win;$(DCC_Namespace) + ..\..\..\..\Net;..\..\..\..\Utils;..\..\..\..\DelphiToFPC;$(DCC_UnitSearchPath) + bin\$(Platform)\ + .\$(Platform)\$(Config) + + + true + true + DEBUG;$(DCC_Define) + true + + + + + + diff --git a/Net/Demos/Delphi/ProxyClient/README.md b/Net/Demos/Delphi/ProxyClient/README.md new file mode 100644 index 0000000..142d570 --- /dev/null +++ b/Net/Demos/Delphi/ProxyClient/README.md @@ -0,0 +1,30 @@ +# ProxyClient demo + +This console demo validates the enhanced `TCrossProxySettings` path against the +proxy shown in the v2rayN screenshot (`127.0.0.1:10808` is the default local +SOCKS listener). + +The first argument selects the application protocol: + +* `http`: HTTPS GET of `https://www.google.com/` (TCP + TLS) +* `doh`: DNS-over-HTTPS GET through the selected proxy (DNS over HTTP(S)) +* `ws`: secure WebSocket echo connection (TCP + TLS + WebSocket) +* `udp`: UDP DNS probe to `8.8.8.8:53`; this requires v2rayN UDP/TUN routing + +The second argument is `direct`, `http`, `https`, `socks4`, or `socks5`; the +remaining arguments are proxy host, port, optional username, and password. + +Examples: + +```text +ProxyClient http socks5 127.0.0.1 10808 +ProxyClient doh socks5 127.0.0.1 10808 +ProxyClient ws socks5 127.0.0.1 10808 + ProxyClient udp socks5 127.0.0.1 10808 +``` + +The HTTP and WebSocket paths use the Cross Socket proxy API. The `udp` mode +implements a SOCKS5 UDP ASSOCIATE probe in the Demo itself (IPv4 relay and +no-authentication method), so it validates the UDP capability of the local +SOCKS5 listener shown in the screenshot. `doh` validates DNS over the selected +HTTP/TCP or SOCKS/TCP stream. diff --git a/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.fmx b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.fmx new file mode 100644 index 0000000..8442797 --- /dev/null +++ b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.fmx @@ -0,0 +1,171 @@ +object ProxyMainForm: TProxyMainForm + Left = 0 + Top = 0 + Caption = 'Delphi Cross Socket - Proxy Demo' + ClientHeight = 508 + ClientWidth = 973 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + DesignerMasterStyle = 0 + object ProxyType: TComboBox + Items.Strings = ( + 'direct' + 'http' + 'https' + 'socks4' + 'socks5') + ItemIndex = 4 + Position.X = 16.000000000000000000 + Position.Y = 16.000000000000000000 + Size.Width = 89.000000000000000000 + Size.Height = 32.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + end + object ProxyHost: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + TabOrder = 1 + Text = '127.0.0.1' + Position.X = 117.000000000000000000 + Position.Y = 16.000000000000000000 + Size.Width = 130.000000000000000000 + Size.Height = 32.000000000000000000 + Size.PlatformDefault = False + end + object ProxyPort: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + TabOrder = 2 + Text = '10808' + Position.X = 257.000000000000000000 + Position.Y = 16.000000000000000000 + Size.Width = 70.000000000000000000 + Size.Height = 32.000000000000000000 + Size.PlatformDefault = False + end + object ProxyUser: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + TabOrder = 3 + Position.X = 418.000000000000000000 + Position.Y = 16.000000000000000000 + Size.Width = 120.000000000000000000 + Size.Height = 32.000000000000000000 + Size.PlatformDefault = False + TextPrompt = 'user' + end + object ProxyPassword: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + TabOrder = 4 + Password = True + Position.X = 548.000000000000000000 + Position.Y = 16.000000000000000000 + Size.Width = 120.000000000000000000 + Size.Height = 32.000000000000000000 + Size.PlatformDefault = False + end + object UseAuth: TCheckBox + Position.X = 335.000000000000000000 + Position.Y = 16.000000000000000000 + Size.Width = 100.000000000000000000 + Size.Height = 32.000000000000000000 + Size.PlatformDefault = False + TabOrder = 14 + Text = 'Use Auth' + OnChange = AuthClick + end + object GoogleButton: TButton + Position.X = 16.000000000000000000 + Position.Y = 64.000000000000000000 + Size.Width = 120.000000000000000000 + Size.Height = 36.000000000000000000 + Size.PlatformDefault = False + TabOrder = 5 + Text = 'Google HTTP' + OnClick = HttpClick + end + object DnsDirectButton: TButton + Position.X = 146.000000000000000000 + Position.Y = 64.000000000000000000 + Size.Width = 120.000000000000000000 + Size.Height = 36.000000000000000000 + Size.PlatformDefault = False + TabOrder = 6 + Text = 'DNS direct' + OnClick = DohDirectClick + end + object DnsProxyButton: TButton + Position.X = 276.000000000000000000 + Position.Y = 64.000000000000000000 + Size.Width = 120.000000000000000000 + Size.Height = 36.000000000000000000 + Size.PlatformDefault = False + TabOrder = 7 + Text = 'DNS proxy' + OnClick = DohProxyClick + end + object ResolveButton: TButton + Position.X = 406.000000000000000000 + Position.Y = 64.000000000000000000 + Size.Width = 120.000000000000000000 + Size.Height = 36.000000000000000000 + Size.PlatformDefault = False + TabOrder = 8 + Text = 'IPv4/IPv6' + OnClick = ResolveClick + end + object WsDirectButton: TButton + Position.X = 556.000000000000000000 + Position.Y = 64.000000000000000000 + Size.Width = 120.000000000000000000 + Size.Height = 36.000000000000000000 + Size.PlatformDefault = False + TabOrder = 9 + Text = 'WS direct' + OnClick = WsDirectClick + end + object WsProxyButton: TButton + Position.X = 686.000000000000000000 + Position.Y = 64.000000000000000000 + Size.Width = 120.000000000000000000 + Size.Height = 36.000000000000000000 + Size.PlatformDefault = False + TabOrder = 10 + Text = 'WS proxy' + OnClick = WsProxyClick + end + object LogMemo: TMemo + Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] + DataDetectorTypes = [] + Lines.Strings = ( + + 'Fields: proxy type (direct/http/https/socks4/socks5), host, port' + + ', user, password.') + Align = Bottom + Position.Y = 113.000000000000000000 + Size.Width = 973.000000000000000000 + Size.Height = 395.000000000000000000 + Size.PlatformDefault = False + TabOrder = 11 + Viewport.Width = 969.000000000000000000 + Viewport.Height = 391.000000000000000000 + end + object EdtWS: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + TabOrder = 12 + Text = 'wss://ws.postman-echo.com/raw' + Position.X = 710.000000000000000000 + Position.Y = 16.000000000000000000 + Size.Width = 217.000000000000000000 + Size.Height = 32.000000000000000000 + Size.PlatformDefault = False + end + object Label1: TLabel + Position.X = 678.000000000000000000 + Position.Y = 23.000000000000000000 + Size.Width = 33.000000000000000000 + Size.Height = 17.000000000000000000 + Size.PlatformDefault = False + Text = 'WS:' + TabOrder = 13 + end +end diff --git a/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.pas b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.pas new file mode 100644 index 0000000..d9e95c9 --- /dev/null +++ b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.pas @@ -0,0 +1,245 @@ +unit ProxyClientGui.Main; + +interface + +uses + System.SysUtils, + System.StrUtils, + System.Classes, + System.Types, + System.UITypes, + FMX.Types, + FMX.Controls, + FMX.Forms, + FMX.StdCtrls, + FMX.Edit, + FMX.ListBox, + FMX.Memo, + FMX.Layouts, + Net.SocketAPI, + Net.Winsock2, + Net.CrossProxy, + Net.CrossHttpClient, + Net.CrossHttpParams, + Net.CrossWebSocketClient, + Net.CrossWebSocketParser, + Utils.Utils, + ProxyDns, + FMX.Memo.Types, + FMX.ScrollBox, + FMX.Controls.Presentation; + +type + TProxyMainForm = class(TForm) + ProxyType: TComboBox; + ProxyHost: TEdit; + ProxyPort: TEdit; + ProxyUser: TEdit; + ProxyPassword: TEdit; + UseAuth: TCheckBox; + GoogleButton: TButton; + DnsDirectButton: TButton; + DnsProxyButton: TButton; + ResolveButton: TButton; + WsDirectButton: TButton; + WsProxyButton: TButton; + LogMemo: TMemo; + EdtWS: TEdit; + Label1: TLabel; + procedure HttpClick(Sender: TObject); + procedure DohDirectClick(Sender: TObject); + procedure DohProxyClick(Sender: TObject); + procedure ResolveClick(Sender: TObject); + procedure WsDirectClick(Sender: TObject); + procedure WsProxyClick(Sender: TObject); + procedure AuthClick(Sender: TObject); + private + FWebSocket: ICrossWebSocket; + function Settings: TCrossProxySettings; + function ProxyLabel(const AUseProxy: Boolean): string; + procedure Log(const AText: string); + procedure Request(const AUrl: string; const AProxy: Boolean); + procedure ResolveDns(const AProxy: Boolean); + procedure ToggleProxyAddress; + procedure WebSocket(const AProxy: Boolean); + end; + +var + ProxyMainForm: TProxyMainForm; + +implementation + +{$R *.fmx} + +procedure TProxyMainForm.AuthClick(Sender: TObject); +begin + if UseAuth.IsChecked then begin + ProxyPort.Text := '10810'; ProxyUser.Text := 'demo'; ProxyPassword.Text := 'demo123'; + end else begin + ProxyPort.Text := '10808'; ProxyUser.Text := 'user'; ProxyPassword.Text := ''; + end; + Log('Use Auth ' + IfThen(UseAuth.IsChecked, 'enabled', 'disabled') + + ': ' + ProxyHost.Text + ':' + ProxyPort.Text); +end; + +function TProxyMainForm.Settings: TCrossProxySettings; +var + LType: TCrossProxyType; +begin + LType := cptDirect; + if SameText(ProxyType.Text, 'http') then + LType := cptHttp; + if SameText(ProxyType.Text, 'https') then + LType := cptHttps; + if SameText(ProxyType.Text, 'socks4') then + LType := cptSocks4; + if SameText(ProxyType.Text, 'socks5') then + LType := cptSocks5; + Result := + TCrossProxySettings + .Create(LType, ProxyHost.Text, StrToIntDef(ProxyPort.Text, 0), ProxyUser.Text, ProxyPassword.Text); +end; + +function TProxyMainForm.ProxyLabel(const AUseProxy: Boolean): string; +begin + if not AUseProxy then + Exit('direct'); + case Settings.ProxyType of + cptHttp: Exit('via proxy http'); + cptHttps: Exit('via proxy https'); + cptSocks4: Exit('via proxy socks4'); + cptSocks5: Exit('via proxy socks5'); + else + Exit('direct'); + end; +end; + +procedure TProxyMainForm.Log(const AText: string); +begin + TThread.Queue(nil, procedure begin LogMemo.Lines.Add(FormatDateTime('hh:nn:ss', Now) + ' ' + AText); end); +end; + +procedure TProxyMainForm.Request(const AUrl: string; const AProxy: Boolean); +var + LClient: ICrossHttpClient; +begin + LClient := TCrossHttpClient.Create; + if AProxy then + LClient.ProxySettings := Settings; + LClient.VerifyPeer := False; + Log('HTTP ' + AUrl + ' ' + ProxyLabel(AProxy)); + LClient.DoRequest( + 'GET', + AUrl, + THttpHeader(nil), + Pointer(nil), + 0, + TStream(nil), + procedure(const ARequest: ICrossHttpClientRequest) begin end, + procedure(const AResponse: ICrossHttpClientResponse) + begin + // Keep the asynchronous client alive until the response callback runs. + if LClient = nil then + Exit; + if AResponse = nil then + Log('HTTP FAILED: no response') + else if AResponse.Content = nil then + // StatusText 包含 Cross Socket 返回的代理认证或 CONNECT 失败原因。 + Log(Format('HTTP FAILED: %d %s', [AResponse.StatusCode, AResponse.StatusText])) + else + Log(Format('HTTP %d %s, %d bytes', [AResponse.StatusCode, AResponse.StatusText, AResponse.Content.Size])); + end + ); +end; + +procedure TProxyMainForm.ResolveDns(const AProxy: Boolean); +var + LSettings: TCrossProxySettings; + LServer, LIP, LIPv6: string; +begin + LSettings := TCrossProxySettings.Direct; + LServer := '223.5.5.5'; + if AProxy then begin + LSettings := Settings; + LServer := '8.8.8.8'; + end; + Log('DNS apple.com ' + ProxyLabel(AProxy) + ' server ' + LServer + ':53'); + try + LIP := QueryDnsA(LServer, LSettings); + LIPv6 := QueryDnsAAAA(LServer, LSettings); + Log('DNS A apple.com -> ' + LIP); + Log('DNS AAAA apple.com -> ' + LIPv6); + except + on E: Exception do + Log('DNS FAILED: ' + E.Message); + end; +end; + +procedure TProxyMainForm.ToggleProxyAddress; +begin + if SameText(ProxyHost.Text, '127.0.0.1') then + ProxyHost.Text := '::1' + else + ProxyHost.Text := '127.0.0.1'; + Log( + 'Proxy address switched to ' + + ProxyHost.Text + + ':' + + ProxyPort.Text + + ' (' + + IfThen(ProxyHost.Text = '::1', 'IPv6', 'IPv4') + + ')' + ); +end; + +procedure TProxyMainForm.WebSocket(const AProxy: Boolean); +var + LManager: TCrossWebSocketMgr; +begin + LManager := TCrossWebSocketMgr.Create; + if AProxy then + LManager.ProxySettings := Settings; + FWebSocket := LManager.CreateWebSocket(EdtWS.Text); + FWebSocket.OnOpen( + procedure + begin + Log('WebSocket OPEN ' + ProxyLabel(AProxy)); + FWebSocket.Send('proxy demo ping'); + end + ); + FWebSocket.OnMessage( + procedure(const AType: TWsMessageType; const AData: TBytes) + begin + Log('WebSocket MESSAGE: ' + TUtils.GetString(AData)); + end + ); + FWebSocket.OnClose(procedure begin Log('WebSocket CLOSE'); end); + FWebSocket.Open; +end; + +procedure TProxyMainForm.HttpClick(Sender: TObject); +begin + Request('https://www.google.com/', True); +end; +procedure TProxyMainForm.DohDirectClick(Sender: TObject); +begin + ResolveDns(False); +end; +procedure TProxyMainForm.DohProxyClick(Sender: TObject); +begin + ResolveDns(True); +end; +procedure TProxyMainForm.ResolveClick(Sender: TObject); +begin + ToggleProxyAddress; +end; +procedure TProxyMainForm.WsDirectClick(Sender: TObject); +begin + WebSocket(False); +end; +procedure TProxyMainForm.WsProxyClick(Sender: TObject); +begin + WebSocket(True); +end; + +end. diff --git a/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dpr b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dpr new file mode 100644 index 0000000..9726567 --- /dev/null +++ b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dpr @@ -0,0 +1,13 @@ +program ProxyClientGui; +uses + System.StartUpCopy, + FMX.Forms, + ProxyClientGui.Main in 'ProxyClientGui.Main.pas' {ProxyMainForm}, + ProxyDns in 'ProxyDns.pas'; + +{$R *.res} +begin + Application.Initialize; + Application.CreateForm(TProxyMainForm, ProxyMainForm); + Application.Run; +end. diff --git a/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dproj b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dproj new file mode 100644 index 0000000..39052d4 --- /dev/null +++ b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dproj @@ -0,0 +1,1062 @@ + + + {3DDA9F4C-7C3F-4F9C-A1A5-6A7C6B7084D1} + ProxyClientGui.dpr + True + Base + 20.4 + 1 + Application + FMX + Win32 + ProxyClientGui + + + true + + + true + Base + true + + + true + Base + true + + + System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;Data.Win;Web.Win;$(DCC_Namespace) + ..\..\..\..\Net;..\..\..\..\Utils;..\..\..\..\DelphiToFPC;$(DCC_UnitSearchPath) + rtl;fmx;$(DCC_UsePackage) + bin\$(Platform)\ + .\$(Platform)\$(Config) + ProxyClientGui + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\delphi_PROJECTICNS.icns + + + Debug + + + Datasnap.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + + MainSource + + +
ProxyMainForm
+ fmx + + + + Base + + + + Delphi.Personality.12 + Application + + + + ProxyClientGui.dpr + + + + + True + False + + + + + true + + + + + true + + + + + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\values-v35 + 1 + + + res\values-v35 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + + 12 + + + + + diff --git a/Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas b/Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas new file mode 100644 index 0000000..c92e674 --- /dev/null +++ b/Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas @@ -0,0 +1,232 @@ +unit ProxyDns; + +interface + +uses + System.SysUtils, + Net.SocketAPI, + Net.Winsock2, + Net.CrossProxy; + +function QueryDnsA(const AServer: string; const AProxy: TCrossProxySettings): string; +function QueryDnsAAAA(const AServer: string; const AProxy: TCrossProxySettings): string; + +implementation + +procedure SendAll(const S: TSocket; const B; N: Integer); +var + P, C: Integer; +begin + P := 0; + while P < N do begin + C := TSocketAPI.Send(S, PByte(@B)[P], N - P); + if C <= 0 then + raise Exception.Create('DNS send failed'); + Inc(P, C); + end; +end; + +procedure ReadAll(const S: TSocket; var B; N: Integer); +var + P, C: Integer; +begin + P := 0; + while P < N do begin + C := TSocketAPI.Recv(S, PByte(@B)[P], N - P); + if C <= 0 then + raise Exception.Create('DNS receive failed'); + Inc(P, C); + end; +end; + +function QueryDnsType(const AServer: string; const AProxy: TCrossProxySettings; const AType: Word): string; +var + Q: array[0..27] of Byte; +var + H: TRawAddrInfo; + I: PRawAddrInfo; + S: TSocket; + P, A: TBytes; + R: array[0..2047] of Byte; + G: array[0..3] of Byte; + Auth: TBytes; + LenBuf: array[0..1] of Byte; + N, L, O, C: Integer; + B: array[0..3] of Byte; + IP: string; +begin + Q[0] := $CA; + Q[1] := $FE; + Q[2] := $01; + Q[3] := $00; + Q[4] := $00; + Q[5] := $01; + Q[6] := $00; + Q[7] := $00; + Q[8] := $00; + Q[9] := $00; + Q[10] := $00; + Q[11] := $00; + Q[12] := $05; + Q[13] := $61; + Q[14] := $70; + Q[15] := $70; + Q[16] := $6C; + Q[17] := $65; + Q[18] := $03; + Q[19] := $63; + Q[20] := $6F; + Q[21] := $6D; + Q[22] := $00; + Q[23] := AType shr 8; + Q[24] := AType and $FF; + Q[25] := $00; + Q[26] := $01; + if AProxy.IsEnabled and (AProxy.ProxyType <> cptSocks5) then + raise Exception.Create('DNS proxy test currently requires SOCKS5'); + FillChar(H, SizeOf(H), 0); + H.ai_family := AF_UNSPEC; + H.ai_socktype := SOCK_STREAM; + H.ai_protocol := IPPROTO_TCP; + I := TSocketAPI.GetAddrInfo(AProxy.Host, AProxy.Port, H); + if not AProxy.IsEnabled then begin + TSocketAPI.FreeAddrInfo(I); + I := TSocketAPI.GetAddrInfo(AServer, 53, H); + end; + if I = nil then + raise Exception.Create('DNS endpoint resolve failed'); + try + S := TSocketAPI.NewSocket(I.ai_family, SOCK_STREAM, IPPROTO_TCP); + try + if TSocketAPI.Connect(S, I.ai_addr, I.ai_addrlen) <> 0 then + raise Exception.Create('DNS endpoint connect failed'); + TSocketAPI.SetRecvTimeout(S, 5000); + if AProxy.IsEnabled then begin + if (AProxy.Username <> '') or (AProxy.Password <> '') then begin + G[0] := $05; + G[1] := $02; + G[2] := $00; + G[3] := $02; + SendAll(S, G, 4); + ReadAll(S, G, 2); + if G[1] <> $02 then + raise Exception.Create('SOCKS5 proxy did not select username/password authentication'); + if (Length(AProxy.Username) > 255) or (Length(AProxy.Password) > 255) then + raise Exception.Create('SOCKS5 credentials exceed 255 bytes'); + SetLength(Auth, 3 + Length(AProxy.Username) + Length(AProxy.Password)); + Auth[0] := $01; + Auth[1] := Length(AProxy.Username); + if Length(AProxy.Username) > 0 then + Move(AProxy.Username[1], Auth[2], Length(AProxy.Username)); + Auth[2 + Length(AProxy.Username)] := Length(AProxy.Password); + if Length(AProxy.Password) > 0 then + Move(AProxy.Password[1], Auth[3 + Length(AProxy.Username)], Length(AProxy.Password)); + SendAll(S, Auth[0], Length(Auth)); + ReadAll(S, G, 2); + if (G[0] <> $01) or (G[1] <> $00) then + raise Exception.Create('SOCKS5 username/password authentication failed'); + end + else begin + G[0] := $05; + G[1] := $01; + G[2] := $00; + SendAll(S, G, 3); + ReadAll(S, G, 2); + if G[1] <> 0 then + raise Exception.Create('SOCKS5 authentication required'); + end; + SetLength(A, 10); + FillChar(A[0], 10, 0); + A[0] := $05; + A[1] := $01; + A[3] := $01; + A[4] := 8; + A[5] := 8; + A[6] := 8; + A[7] := 8; + A[8] := 0; + A[9] := 53; + SendAll(S, A[0], 10); + ReadAll(S, A[0], 4); + if A[1] <> 0 then + raise Exception.Create('SOCKS5 connect to DNS failed'); + ReadAll(S, A[0], 6); + end; + SetLength(P, 29); + P[0] := 0; + P[1] := 27; + Move(Q[0], P[2], 27); + SendAll(S, P[0], Length(P)); + ReadAll(S, LenBuf[0], 2); + L := LenBuf[0] shl 8 or LenBuf[1]; + if L > SizeOf(R) then + raise Exception.Create('DNS response too large'); + ReadAll(S, R[0], L); + O := 12; + while (O < L) and (R[O] <> 0) do + Inc(O, R[O] + 1); + Inc(O, 5); + C := R[6] shl 8 or R[7]; + while (C > 0) and (O + 11 < L) do begin + if (R[O] and $C0) = $C0 then + Inc(O, 2) + else begin + while (O < L) and (R[O] <> 0) do + Inc(O, R[O] + 1); + Inc(O); + end; + N := R[O] shl 8 or R[O + 1]; + Inc(O, 2); + Inc(O, 2); + Inc(O, 4); + L := L; + if (N = AType) and (O + 1 < L) then begin + N := R[O] shl 8 or R[O + 1]; + Inc(O, 2); + if (AType = 1) and (N = 4) then begin + IP := Format('%d.%d.%d.%d', [R[O], R[O + 1], R[O + 2], R[O + 3]]); + Break; + end + else if (AType = 28) and (N = 16) then begin + IP := + Format( + '%x:%x:%x:%x:%x:%x:%x:%x', + [ + R[O] shl 8 or R[O + 1], + R[O + 2] shl 8 or R[O + 3], + R[O + 4] shl 8 or R[O + 5], + R[O + 6] shl 8 or R[O + 7], + R[O + 8] shl 8 or R[O + 9], + R[O + 10] shl 8 or R[O + 11], + R[O + 12] shl 8 or R[O + 13], + R[O + 14] shl 8 or R[O + 15] + ] + ); + Break; + end; + Inc(O, N); + end + else + Inc(O, N); + Dec(C); + end; + Result := IP; + finally + TSocketAPI.CloseSocket(S); + end; + finally + TSocketAPI.FreeAddrInfo(I); + end; +end; + +function QueryDnsA(const AServer: string; const AProxy: TCrossProxySettings): string; +begin + Result := QueryDnsType(AServer, AProxy, 1); +end; + +function QueryDnsAAAA(const AServer: string; const AProxy: TCrossProxySettings): string; +begin + Result := QueryDnsType(AServer, AProxy, 28); +end; + +end. diff --git a/Net/Demos/Delphi/ProxyClientGui/README.md b/Net/Demos/Delphi/ProxyClientGui/README.md new file mode 100644 index 0000000..af959fd --- /dev/null +++ b/Net/Demos/Delphi/ProxyClientGui/README.md @@ -0,0 +1,21 @@ +# ProxyClientGui + +FMX GUI demo for comparing direct and proxy traffic. + +Configure the first five fields as `proxy type`, `host`, `port`, `user`, and +`password`. Supported types are `direct`, `http`, `https`, `socks4`, and +`socks5`. + +The buttons demonstrate: + +- Google HTTPS GET +- Standard DNS-over-TCP lookup for `github.com`: direct via `223.5.5.5`, or through SOCKS5 via `8.8.8.8` +- The `IPv4/IPv6` button toggles the configured proxy host between `127.0.0.1` and `::1`; every proxy test uses the selected host. +- OS IPv4/IPv6 address resolution for `github.com` +- WebSocket echo, direct and through the selected proxy + +The IPv4/IPv6 button intentionally reports OS `GetAddrInfo` results. The +Cross Socket HTTP/DoH/WebSocket paths use the selected proxy; DoH proxy mode is +The proxy DNS test currently uses SOCKS5 TCP CONNECT to the configured DNS server. It does not use an online DoH service. + +IPv6 proxy verification requires the local proxy to listen on `::1`. The current v2ray listener must be configured for IPv6 separately; the observed `10808` listener was IPv4-only. diff --git a/Net/Net.CrossHttpClient.pas b/Net/Net.CrossHttpClient.pas index aa9aa92..98a9c19 100644 --- a/Net/Net.CrossHttpClient.pas +++ b/Net/Net.CrossHttpClient.pas @@ -26,6 +26,7 @@ interface Generics.Collections, Net.SocketAPI, + Net.CrossProxy, Net.CrossSocket.Base, Net.CrossSslSocket.Base, Net.CrossSslSocket, @@ -386,6 +387,10 @@ TServerDock = class; ['{8944949B-EC8D-406E-B471-F1BF6BEDA15B}'] function GetLocalPort: Word; procedure SetLocalPort(const AValue: Word); + procedure ConnectTarget(const APhysicalHost: string; + const APhysicalPort, ALocalPort: Word; const ALogicalHost: string; + const ALogicalPort: Word; + const ACallback: TCrossConnectionCallback = nil); {$REGION 'Documentation'} /// @@ -447,6 +452,7 @@ TServerDock = class; function GetAutoUrlEncode: Boolean; function GetLocalPort: Word; function GetVerifyPeer: Boolean; + function GetProxySettings: TCrossProxySettings; procedure SetIdleout(const AValue: Integer); procedure SetIoThreads(const AValue: Integer); @@ -458,6 +464,7 @@ TServerDock = class; procedure SetAutoUrlEncode(const AValue: Boolean); procedure SetLocalPort(const AValue: Word); procedure SetVerifyPeer(const AValue: Boolean); + procedure SetProxySettings(const AValue: TCrossProxySettings); /// /// 设置客户端证书 @@ -934,6 +941,7 @@ TServerDock = class; /// 是否强制验证对端证书。服务端要求客户端证书，客户端同时验证服务端主机名。 /// property VerifyPeer: Boolean read GetVerifyPeer write SetVerifyPeer; + property ProxySettings: TCrossProxySettings read GetProxySettings write SetProxySettings; end; TCrossHttpClientConnection = class(TCrossSslConnection, ICrossHttpClientConnection) @@ -1229,6 +1237,7 @@ TCrossHttpClientSocket = class(TCrossSslSocket, ICrossHttpClientSocket) FServerDockDict: TServerDockDict; FServerDockLock: ILock; FLocalPort: Word; + FProxySettings: TCrossProxySettings; procedure _LockServerDock; inline; procedure _UnlockServerDock; inline; @@ -1240,10 +1249,18 @@ TCrossHttpClientSocket = class(TCrossSslSocket, ICrossHttpClientSocket) protected function GetLocalPort: Word; procedure SetLocalPort(const AValue: Word); + procedure ConnectTarget(const APhysicalHost: string; + const APhysicalPort, ALocalPort: Word; const ALogicalHost: string; + const ALogicalPort: Word; + const ACallback: TCrossConnectionCallback = nil); override; + public + procedure SyncProxySettings(const AValue: TCrossProxySettings); protected function CreateConnection(const AOwner: TCrossSocketBase; const AClientSocket: TSocket; const AConnectType: TConnectType; const AHost: string; const AConnectCb: TCrossConnectionCallback): ICrossConnection; override; + procedure PrepareConnection(const AConnection: ICrossConnection; + const ALogicalHost: string; const ALogicalPort: Word); override; procedure LogicReceived(const AConnection: ICrossConnection; const ABuf: Pointer; const ALen: Integer); override; procedure LogicDisconnected(const AConnection: ICrossConnection); override; public @@ -1281,6 +1298,7 @@ TCrossHttpClient = class(TInterfacedObject, ICrossHttpClient) FReUseConnection, FAutoUrlEncode: Boolean; FLocalPort: Word; FVerifyPeer: Boolean; + FProxySettings: TCrossProxySettings; FCertificate, FPrivateKey: TBytes; FPrivateKeyPassword: string; FCACertificates: TArray; @@ -1304,6 +1322,7 @@ TCrossHttpClient = class(TInterfacedObject, ICrossHttpClient) function GetAutoUrlEncode: Boolean; function GetLocalPort: Word; function GetVerifyPeer: Boolean; + function GetProxySettings: TCrossProxySettings; procedure SetIdleout(const AValue: Integer); procedure SetIoThreads(const AValue: Integer); @@ -1315,6 +1334,7 @@ TCrossHttpClient = class(TInterfacedObject, ICrossHttpClient) procedure SetAutoUrlEncode(const AValue: Boolean); procedure SetLocalPort(const AValue: Word); procedure SetVerifyPeer(const AValue: Boolean); + procedure SetProxySettings(const AValue: TCrossProxySettings); virtual; public constructor Create(const AIoThreads, AMaxConnsPerServer: Integer; const ACompressType: TCompressType = ctNone); overload; @@ -1421,6 +1441,7 @@ TCrossHttpClient = class(TInterfacedObject, ICrossHttpClient) property AutoUrlEncode: Boolean read GetAutoUrlEncode write SetAutoUrlEncode; property LocalPort: Word read GetLocalPort write SetLocalPort; property VerifyPeer: Boolean read GetVerifyPeer write SetVerifyPeer; + property ProxySettings: TCrossProxySettings read GetProxySettings write SetProxySettings; end; const @@ -2052,10 +2073,19 @@ procedure TCrossHttpClientConnection._BeginRequest; function TCrossHttpClientConnection._CreateRequestHeader(const ABodySize: Int64; AChunked: Boolean): TBytes; var - LHeaderStr, LCookieStr, LPathStr: string; + LHeaderStr, LCookieStr, LPathStr, LProxyAuthorization: string; + LHttpSocket: TCrossHttpClientSocket; + LUseHttpForwardProxy: Boolean; begin _ReqLock; try + LHttpSocket := Owner as TCrossHttpClientSocket; + LUseHttpForwardProxy := + not Ssl and + LHttpSocket.FProxySettings.IsEnabled and + (LHttpSocket.FProxySettings.ProxyType = cptHttp) and + not LHttpSocket.FProxySettings.ShouldBypass(FHost); + if (FRequestObj.FHeader[HEADER_CACHE_CONTROL] = '') then FRequestObj.FHeader[HEADER_CACHE_CONTROL] := 'no-cache'; @@ -2065,7 +2095,7 @@ function TCrossHttpClientConnection._CreateRequestHeader(const ABodySize: Int64; if (FRequestObj.FHeader[HEADER_CONNECTION] = '') then begin // Owner 在 TCrossHttpClientSocket.CreateConnection 中固定为 TCrossHttpClientSocket - if (Owner as TCrossHttpClientSocket).FReUseConnection then + if LHttpSocket.FReUseConnection then FRequestObj.FHeader[HEADER_CONNECTION] := 'keep-alive' else FRequestObj.FHeader[HEADER_CONNECTION] := 'close'; @@ -2118,6 +2148,16 @@ function TCrossHttpClientConnection._CreateRequestHeader(const ABodySize: Int64; end else LPathStr := FRequestObj.FPathAndParams; + if LUseHttpForwardProxy then + begin + LPathStr := FRequestObj.FProtocol + '://' + + FRequestObj.FHeader[HEADER_HOST] + LPathStr; + LProxyAuthorization := LHttpSocket.FProxySettings.HttpProxyAuthorization; + if (LProxyAuthorization <> '') and + (FRequestObj.FHeader['Proxy-Authorization'] = '') then + FRequestObj.FHeader['Proxy-Authorization'] := LProxyAuthorization; + end; + // 设置请求行 LHeaderStr := FRequestObj.FMethod + ' ' + LPathStr + ' ' @@ -2717,6 +2757,7 @@ constructor TCrossHttpClientSocket.Create(const AHttpClient: TCrossHttpClient; FMaxConnsPerServer := AMaxConnsPerServer; FMaxCompressRatio := AMaxCompressRatio; FCompressType := ACompressType; + FProxySettings := AHttpClient.FProxySettings; inherited Create(AIoThreads, ASsl); @@ -2736,6 +2777,21 @@ function TCrossHttpClientSocket.CreateConnection(const AOwner: TCrossSocketBase; AConnectCb); end; +procedure TCrossHttpClientSocket.PrepareConnection( + const AConnection: ICrossConnection; const ALogicalHost: string; + const ALogicalPort: Word); +begin + inherited PrepareConnection(AConnection, ALogicalHost, ALogicalPort); + if not Ssl and FProxySettings.IsEnabled and + (FProxySettings.ProxyType = cptHttp) and + not FProxySettings.ShouldBypass(ALogicalHost) then + (AConnection as TCrossConnectionBase).ConfigureProxy( + TCrossProxySettings.Direct, ALogicalHost, ALogicalPort) + else + (AConnection as TCrossConnectionBase).ConfigureProxy( + FProxySettings, ALogicalHost, ALogicalPort); +end; + destructor TCrossHttpClientSocket.Destroy; begin FreeAndNil(FServerDockDict); @@ -2849,6 +2905,22 @@ procedure TCrossHttpClientSocket.SetLocalPort(const AValue: Word); FLocalPort := AValue; end; +procedure TCrossHttpClientSocket.ConnectTarget( + const APhysicalHost: string; const APhysicalPort, ALocalPort: Word; + const ALogicalHost: string; const ALogicalPort: Word; + const ACallback: TCrossConnectionCallback); +begin + inherited ConnectTarget(APhysicalHost, APhysicalPort, ALocalPort, + ALogicalHost, ALogicalPort, ACallback); +end; + +procedure TCrossHttpClientSocket.SyncProxySettings( + const AValue: TCrossProxySettings); +begin + FProxySettings := AValue; + CloseAll; +end; + function TCrossHttpClientSocket._GetServerDock(const AProtocol, AHost: string; const APort: Word): IServerDock; var @@ -2881,8 +2953,8 @@ procedure TCrossHttpClientSocket._LockServerDock; function TCrossHttpClientSocket._MakeServerDockKey(const AProtocol, AHost: string; const APort: Word): string; begin - Result := TStrUtils.Format('%s://%s:%d', [ - AProtocol, AHost, APort + Result := TStrUtils.Format('%s://%s:%d|%s', [ + AProtocol, AHost, APort, FProxySettings.CacheKey ]); end; @@ -2931,6 +3003,7 @@ constructor TCrossHttpClient.Create(const AIoThreads, FMaxConnsPerServer := AMaxConnsPerServer; FMaxCompressRatio := DEFAULT_MAX_COMPRESS_RATIO; FCompressType := ACompressType; + FProxySettings := TCrossProxySettings.Direct; FLock := TLock.Create; FHttpCliArr := []; @@ -2989,6 +3062,7 @@ function TCrossHttpClient.CreateHttpCli(const AProtocol: string): ICrossHttpClie FMaxConnsPerServer, FMaxCompressRatio, False, FReUseConnection, FAutoUrlEncode, FCompressType); + (FHttpCli as TObject as TCrossHttpClientSocket).SyncProxySettings(FProxySettings); FHttpCliArr := FHttpCliArr + [FHttpCli]; end; @@ -3003,6 +3077,7 @@ function TCrossHttpClient.CreateHttpCli(const AProtocol: string): ICrossHttpClie FReUseConnection, FAutoUrlEncode, FCompressType); _ApplyTlsOptions(LHttpsCli); + (LHttpsCli as TObject as TCrossHttpClientSocket).SyncProxySettings(FProxySettings); FHttpsCli := LHttpsCli; FHttpCliArr := FHttpCliArr + [FHttpsCli]; end; @@ -3584,6 +3659,16 @@ function TCrossHttpClient.GetVerifyPeer: Boolean; end; end; +function TCrossHttpClient.GetProxySettings: TCrossProxySettings; +begin + _Lock; + try + Result := FProxySettings; + finally + _Unlock; + end; +end; + function TCrossHttpClient.GetMaxConnsPerServer: Integer; begin Result := FMaxConnsPerServer; @@ -3658,6 +3743,24 @@ procedure TCrossHttpClient.SetVerifyPeer(const AValue: Boolean); end; end; +procedure TCrossHttpClient.SetProxySettings( + const AValue: TCrossProxySettings); +var + LHttpCli: ICrossHttpClientSocket; + LHttpCliArr: TArray; +begin + _Lock; + try + FProxySettings := AValue; + LHttpCliArr := Copy(FHttpCliArr); + finally + _Unlock; + end; + + for LHttpCli in LHttpCliArr do + (LHttpCli as TObject as TCrossHttpClientSocket).SyncProxySettings(AValue); +end; + procedure TCrossHttpClient.SetMaxCompressRatio(const AValue: Integer); begin // 同步到所有已创建的 socket; 已建立的 connection 上 parser 已用旧值, 仅影响后续新建连接. @@ -3806,8 +3909,11 @@ procedure TServerDock._HandleConnectFailure( LErrMsg := 'Connect failed'; if (AConnection <> nil) then begin + // 代理握手错误优先于底层 socket 错误, 这样 407/认证失败不会被吞掉。 + if AConnection.ProxyError <> '' then + LErrMsg := 'Connect failed: ' + AConnection.ProxyError; LErrCode := AConnection.LastNetError; - if (LErrCode <> 0) then + if (LErrCode <> 0) and (Pos('Connect failed:', LErrMsg) = 0) then LErrMsg := TStrUtils.Format('Connect failed (code=%d)', [LErrCode]); end; try @@ -3852,7 +3958,8 @@ procedure TServerDock.DoRequest(const ARequest: ICrossHttpClientRequest); LRequestObj: TCrossHttpClientRequest; LClientSocket: TCrossHttpClientSocket; LProtocol, LRawHost, LHost: string; - LPort, LLocalPort: Word; + LPort, LLocalPort, LPhysicalPort: Word; + LPhysicalHost: string; begin LRequest := ARequest; LRequestObj := LRequest as TCrossHttpClientRequest; @@ -3898,9 +4005,18 @@ procedure TServerDock.DoRequest(const ARequest: ICrossHttpClientRequest); LHost := FHost; LPort := FPort; LLocalPort := FLocalPort; + LPhysicalHost := LHost; + LPhysicalPort := LPort; + if LClientSocket.FProxySettings.IsEnabled and + not LClientSocket.FProxySettings.ShouldBypass(LHost) then + begin + LPhysicalHost := LClientSocket.FProxySettings.Host; + LPhysicalPort := LClientSocket.FProxySettings.Port; + end; try - LClientSocket.Connect(LHost, LPort, LLocalPort, + LClientSocket.ConnectTarget(LPhysicalHost, LPhysicalPort, LLocalPort, + LHost, LPort, procedure(const AConnection: ICrossConnection; const ASuccess: Boolean) begin try diff --git a/Net/Net.CrossProxy.pas b/Net/Net.CrossProxy.pas new file mode 100644 index 0000000..9e9dc7d --- /dev/null +++ b/Net/Net.CrossProxy.pas @@ -0,0 +1,537 @@ +{******************************************************************************} +{ } +{ Delphi cross platform socket library } +{ } +{******************************************************************************} +unit Net.CrossProxy; + +{$I zLib.inc} + +interface + +uses + SysUtils, + Classes, + System.NetEncoding, + System.Net.URLClient; + +type + TCrossProxyFeedResult = ( + cpfrNeedData, + cpfrSendData, + cpfrComplete, + cpfrFailed); + + TCrossProxyType = ( + cptDirect, + cptHttp, + cptHttps, + cptSocks4, + cptSocks5); + + TCrossProxySettings = record + private + FEnabled: Boolean; + FProxyType: TCrossProxyType; + FHost: string; + FPort: Word; + FUsername: string; + FPassword: string; + FBypassList: string; + public + class function Direct: TCrossProxySettings; static; + class function Create(const AProxyType: TCrossProxyType; + const AHost: string; const APort: Word; + const AUsername: string = ''; const APassword: string = ''; + const ABypassList: string = ''): TCrossProxySettings; static; + + function IsEnabled: Boolean; + function ShouldBypass(const AHost: string): Boolean; + function EffectiveBypassList: string; + function UsesHttpConnect: Boolean; + function UsesTlsProxyTransport: Boolean; + function UsesCrossSocketHttp: Boolean; + function UsesSocks: Boolean; + function CacheKey: string; + function HttpProxyAuthorization: string; + function ToNetProxySettings: System.Net.URLClient.TProxySettings; + + property Enabled: Boolean read FEnabled write FEnabled; + property ProxyType: TCrossProxyType read FProxyType write FProxyType; + property Host: string read FHost write FHost; + property Port: Word read FPort write FPort; + property Username: string read FUsername write FUsername; + property Password: string read FPassword write FPassword; + property BypassList: string read FBypassList write FBypassList; + end; + + TCrossProxySettingsStore = class + private + class var FDefaultSettings: TCrossProxySettings; + public + class procedure SetDefault(const ASettings: TCrossProxySettings); static; + class function Default: TCrossProxySettings; static; + class function ForHost(const AHost: string): TCrossProxySettings; static; + end; + + TCrossProxyCodec = record + private + class function BytesOfAscii(const AValue: string): TBytes; static; + class function TryParseIPv4(const AHost: string; out AValue: Cardinal): Boolean; static; + class function TryParseCidr(const ARule: string; out ANetwork, + AMask: Cardinal): Boolean; static; + public + class function BuildHttpConnect(const AHost: string; const APort: Word; + const AUsername: string = ''; const APassword: string = ''): TBytes; static; + class function BuildSocks4Connect(const AHost: string; const APort: Word; + const AUsername: string = ''): TBytes; static; + class function BuildSocks5Greeting(const AHasCredentials: Boolean): TBytes; static; + class function BuildSocks5Auth(const AUsername, APassword: string): TBytes; static; + class function BuildSocks5Connect(const AHost: string; const APort: Word): TBytes; static; + + class function TryParseHttpConnectResponse(const AData: TBytes; + out AConsumed: Integer; out AStatusCode: Integer): Boolean; static; + class function TryParseSocks4Response(const AData: TBytes; + out AConsumed: Integer; out ASuccess: Boolean): Boolean; static; + class function TryParseSocks5MethodResponse(const AData: TBytes; + out AConsumed: Integer; out AMethod: Byte): Boolean; static; + class function TryParseSocks5AuthResponse(const AData: TBytes; + out AConsumed: Integer; out ASuccess: Boolean): Boolean; static; + class function TryParseSocks5ConnectResponse(const AData: TBytes; + out AConsumed: Integer; out ASuccess: Boolean): Boolean; static; + end; + +implementation + +const + CRLF = #13#10; + DEFAULT_BYPASS_LIST = + 'localhost;127.0.0.0/8;::1;10.0.0.0/8;172.16.0.0/12;192.168.0.0/16;169.254.0.0/16'; + +function NormalizeHost(const AHost: string): string; +begin + Result := Trim(AHost).ToLower; + if (Length(Result) >= 2) and (Result[1] = '[') and + (Result[Length(Result)] = ']') then + Result := Result.Substring(1, Length(Result) - 2); +end; + +function AppendByte(var AData: TBytes; const AValue: Byte): Integer; +begin + Result := Length(AData); + SetLength(AData, Result + 1); + AData[Result] := AValue; +end; + +function AppendBytes(var AData: TBytes; const AValue: TBytes): Integer; +var + LOffset: Integer; +begin + LOffset := Length(AData); + Result := LOffset; + SetLength(AData, LOffset + Length(AValue)); + if Length(AValue) > 0 then + Move(AValue[0], AData[LOffset], Length(AValue)); +end; + +function AppendAscii(var AData: TBytes; const AValue: string): Integer; +begin + Result := AppendBytes(AData, TCrossProxyCodec.BytesOfAscii(AValue)); +end; + +class function TCrossProxySettings.Direct: TCrossProxySettings; +begin + Result.FEnabled := False; + Result.FProxyType := cptDirect; + Result.FHost := ''; + Result.FPort := 0; + Result.FUsername := ''; + Result.FPassword := ''; + Result.FBypassList := ''; +end; + +class function TCrossProxySettings.Create(const AProxyType: TCrossProxyType; + const AHost: string; const APort: Word; const AUsername, + APassword, ABypassList: string): TCrossProxySettings; +begin + Result := Direct; + Result.FEnabled := AProxyType <> cptDirect; + Result.FProxyType := AProxyType; + Result.FHost := Trim(AHost); + Result.FPort := APort; + Result.FUsername := AUsername; + Result.FPassword := APassword; + Result.FBypassList := ABypassList; +end; + +function TCrossProxySettings.IsEnabled: Boolean; +begin + Result := FEnabled and (FProxyType <> cptDirect) and + (FHost <> '') and (FPort <> 0); +end; + +function TCrossProxySettings.ShouldBypass(const AHost: string): Boolean; +var + LRules: TArray; + LRule, LHost, LCurrentRule: string; + LValue, LNetwork, LMask: Cardinal; +begin + LHost := NormalizeHost(AHost); + if LHost = '' then + Exit(False); + + if Trim(FBypassList) = '' then + LRules := DEFAULT_BYPASS_LIST.Split([';']) + else + LRules := (DEFAULT_BYPASS_LIST + ';' + FBypassList).Split([';', ',']); + + for LRule in LRules do + begin + LCurrentRule := NormalizeHost(LRule); + if LCurrentRule = '' then + Continue; + + if SameText(LCurrentRule, '*') or SameText(LCurrentRule, LHost) then + Exit(True); + + if (LCurrentRule = 'localhost') and SameText(LHost, 'localhost') then + Exit(True); + + if (LCurrentRule.StartsWith('*.') and + LHost.EndsWith(LCurrentRule.Substring(1))) then + Exit(True); + + if TCrossProxyCodec.TryParseIPv4(LHost, LValue) and + TCrossProxyCodec.TryParseCidr(LCurrentRule, LNetwork, LMask) + and ((LValue and LMask) = LNetwork) then + Exit(True); + end; + + Result := False; +end; + +function TCrossProxySettings.EffectiveBypassList: string; +begin + Result := Trim(FBypassList); + if Result = '' then + Result := DEFAULT_BYPASS_LIST; + if Result <> DEFAULT_BYPASS_LIST then + Result := DEFAULT_BYPASS_LIST + ';' + Result; +end; + +function TCrossProxySettings.UsesHttpConnect: Boolean; +begin + Result := IsEnabled and (FProxyType in [cptHttp, cptHttps]); +end; + +function TCrossProxySettings.UsesTlsProxyTransport: Boolean; +begin + Result := IsEnabled and (FProxyType = cptHttps); +end; + +function TCrossProxySettings.UsesCrossSocketHttp: Boolean; +begin + Result := IsEnabled and + (FProxyType in [cptHttps, cptSocks4, cptSocks5]); +end; + +function TCrossProxySettings.UsesSocks: Boolean; +begin + Result := IsEnabled and (FProxyType in [cptSocks4, cptSocks5]); +end; + +function TCrossProxySettings.CacheKey: string; +begin + Result := Format('%d|%s|%d|%s|%s', [ + Ord(FProxyType), NormalizeHost(FHost), FPort, + FUsername + #0 + FPassword, FBypassList]); +end; + +function TCrossProxySettings.HttpProxyAuthorization: string; +begin + if (FUsername = '') and (FPassword = '') then + Exit(''); + + Result := 'Basic ' + TNetEncoding.Base64.Encode(FUsername + ':' + FPassword); +end; + +function TCrossProxySettings.ToNetProxySettings: System.Net.URLClient.TProxySettings; +var + LScheme: string; +begin + if not IsEnabled then + Exit(System.Net.URLClient.TProxySettings.Create('direct', 80, '', '', 'http')); + + case FProxyType of + cptHttps: + LScheme := 'https'; + cptSocks4: + LScheme := 'socks4'; + cptSocks5: + LScheme := 'socks5'; + else + LScheme := 'http'; + end; + + Result := System.Net.URLClient.TProxySettings.Create( + FHost, FPort, FUsername, FPassword, LScheme); +end; + +class procedure TCrossProxySettingsStore.SetDefault( + const ASettings: TCrossProxySettings); +begin + FDefaultSettings := ASettings; +end; + +class function TCrossProxySettingsStore.Default: TCrossProxySettings; +begin + Result := FDefaultSettings; +end; + +class function TCrossProxySettingsStore.ForHost( + const AHost: string): TCrossProxySettings; +begin + Result := FDefaultSettings; + if Result.ShouldBypass(AHost) then + Result := TCrossProxySettings.Direct; +end; + +class function TCrossProxyCodec.BytesOfAscii(const AValue: string): TBytes; +begin + Result := TEncoding.ASCII.GetBytes(AValue); +end; + +class function TCrossProxyCodec.TryParseIPv4(const AHost: string; + out AValue: Cardinal): Boolean; +var + LParts: TArray; + I, LPart: Integer; +begin + Result := False; + AValue := 0; + LParts := NormalizeHost(AHost).Split(['.']); + if Length(LParts) <> 4 then + Exit; + for I := 0 to 3 do + begin + if not TryStrToInt(LParts[I], LPart) or (LPart < 0) or (LPart > 255) then + Exit; + AValue := (AValue shl 8) or Cardinal(LPart); + end; + Result := True; +end; + +class function TCrossProxyCodec.TryParseCidr(const ARule: string; + out ANetwork, AMask: Cardinal): Boolean; +var + LParts: TArray; + LPrefix: Integer; + LValue: Cardinal; +begin + Result := False; + ANetwork := 0; + AMask := 0; + LParts := ARule.Split(['/']); + if (Length(LParts) <> 2) or not TryParseIPv4(LParts[0], LValue) or + not TryStrToInt(LParts[1], LPrefix) or (LPrefix < 0) or (LPrefix > 32) then + Exit; + if LPrefix = 0 then + AMask := 0 + else + AMask := Cardinal($FFFFFFFF) shl (32 - LPrefix); + ANetwork := LValue and AMask; + Result := True; +end; + +class function TCrossProxyCodec.BuildHttpConnect(const AHost: string; + const APort: Word; const AUsername, APassword: string): TBytes; +var + LAuth: string; +begin + Result := nil; + AppendAscii(Result, Format( + 'CONNECT %s:%d HTTP/1.1'#13#10 + + 'Host: %s:%d'#13#10 + + 'Proxy-Connection: keep-alive'#13#10, + [AHost, APort, AHost, APort])); + if (AUsername <> '') or (APassword <> '') then + begin + LAuth := TNetEncoding.Base64.Encode(AUsername + ':' + APassword); + AppendAscii(Result, 'Proxy-Authorization: Basic ' + LAuth + CRLF); + end; + AppendAscii(Result, CRLF); +end; + +class function TCrossProxyCodec.BuildSocks4Connect(const AHost: string; + const APort: Word; const AUsername: string): TBytes; +var + LAddress: Cardinal; +begin + Result := [4, 1, Byte(APort shr 8), Byte(APort)]; + if TryParseIPv4(AHost, LAddress) then + begin + AppendByte(Result, Byte(LAddress shr 24)); + AppendByte(Result, Byte(LAddress shr 16)); + AppendByte(Result, Byte(LAddress shr 8)); + AppendByte(Result, Byte(LAddress)); + AppendAscii(Result, AUsername); + AppendByte(Result, 0); + end + else + begin + AppendByte(Result, 0); + AppendByte(Result, 0); + AppendByte(Result, 0); + AppendByte(Result, 1); + AppendAscii(Result, AUsername); + AppendByte(Result, 0); + AppendAscii(Result, AHost); + AppendByte(Result, 0); + end; +end; + +class function TCrossProxyCodec.BuildSocks5Greeting( + const AHasCredentials: Boolean): TBytes; +begin + if AHasCredentials then + Result := [5, 2, 0, 2] + else + Result := [5, 1, 0]; +end; + +class function TCrossProxyCodec.BuildSocks5Auth(const AUsername, + APassword: string): TBytes; +var + LUser, LPassword: TBytes; +begin + LUser := BytesOfAscii(AUsername); + LPassword := BytesOfAscii(APassword); + if (Length(LUser) > 255) or (Length(LPassword) > 255) then + raise EArgumentException.Create('SOCKS5 credentials exceed 255 bytes.'); + Result := [1, Length(LUser)]; + AppendBytes(Result, LUser); + AppendByte(Result, Length(LPassword)); + AppendBytes(Result, LPassword); +end; + +class function TCrossProxyCodec.BuildSocks5Connect(const AHost: string; + const APort: Word): TBytes; +var + LAddress: Cardinal; + LHostBytes: TBytes; +begin + Result := [5, 1, 0]; + if TryParseIPv4(AHost, LAddress) then + begin + AppendByte(Result, 1); + AppendByte(Result, Byte(LAddress shr 24)); + AppendByte(Result, Byte(LAddress shr 16)); + AppendByte(Result, Byte(LAddress shr 8)); + AppendByte(Result, Byte(LAddress)); + end + else + begin + LHostBytes := BytesOfAscii(AHost); + if Length(LHostBytes) > 255 then + raise EArgumentException.Create('SOCKS5 host exceeds 255 bytes.'); + AppendByte(Result, 3); + AppendByte(Result, Length(LHostBytes)); + AppendBytes(Result, LHostBytes); + end; + AppendByte(Result, Byte(APort shr 8)); + AppendByte(Result, Byte(APort)); +end; + +class function TCrossProxyCodec.TryParseHttpConnectResponse( + const AData: TBytes; out AConsumed, AStatusCode: Integer): Boolean; +var + LText, LLine: string; + LEnd, LSpace: Integer; +begin + Result := False; + AConsumed := 0; + AStatusCode := 0; + if Length(AData) = 0 then + Exit; + LText := TEncoding.ASCII.GetString(AData); + LEnd := LText.IndexOf(CRLF + CRLF); + if LEnd < 0 then + Exit; + LLine := LText.Substring(0, LText.IndexOf(CRLF)); + LSpace := LLine.IndexOf(' '); + if (LSpace < 0) or not TryStrToInt(LLine.Substring(LSpace + 1, 3), AStatusCode) then + Exit; + AConsumed := LEnd + 4; + Result := True; +end; + +class function TCrossProxyCodec.TryParseSocks4Response(const AData: TBytes; + out AConsumed: Integer; out ASuccess: Boolean): Boolean; +begin + Result := Length(AData) >= 8; + AConsumed := 0; + ASuccess := False; + if not Result then + Exit; + AConsumed := 8; + ASuccess := AData[1] = 90; +end; + +class function TCrossProxyCodec.TryParseSocks5MethodResponse( + const AData: TBytes; out AConsumed: Integer; out AMethod: Byte): Boolean; +begin + Result := Length(AData) >= 2; + AConsumed := 0; + AMethod := $FF; + if not Result then + Exit; + AConsumed := 2; + AMethod := AData[1]; +end; + +class function TCrossProxyCodec.TryParseSocks5AuthResponse( + const AData: TBytes; out AConsumed: Integer; out ASuccess: Boolean): Boolean; +begin + Result := Length(AData) >= 2; + AConsumed := 0; + ASuccess := False; + if not Result then + Exit; + AConsumed := 2; + ASuccess := AData[1] = 0; +end; + +class function TCrossProxyCodec.TryParseSocks5ConnectResponse( + const AData: TBytes; out AConsumed: Integer; out ASuccess: Boolean): Boolean; +var + LAddressType, LAddressLength: Integer; +begin + Result := False; + AConsumed := 0; + ASuccess := False; + if Length(AData) < 5 then + Exit; + LAddressType := AData[3]; + case LAddressType of + 1: LAddressLength := 4; + 3: + begin + if Length(AData) < 5 then + Exit; + LAddressLength := 1 + AData[4]; + end; + 4: LAddressLength := 16; + else + Exit; + end; + AConsumed := 4 + LAddressLength + 2; + if Length(AData) < AConsumed then + begin + AConsumed := 0; + Exit(False); + end; + ASuccess := AData[1] = 0; + Result := True; +end; + +end. diff --git a/Net/Net.CrossSocket.Base.pas b/Net/Net.CrossSocket.Base.pas index 45fd731..e560b16 100644 --- a/Net/Net.CrossSocket.Base.pas +++ b/Net/Net.CrossSocket.Base.pas @@ -33,6 +33,7 @@ interface {$ENDIF} Net.SocketAPI, + Net.CrossProxy, Utils.StrUtils, Utils.SyncObjs, Utils.Rtti; @@ -239,6 +240,7 @@ TIoEventThread = class; function GetConnectType: TConnectType; function GetConnectStatus: TConnectStatus; function GetLastNetError: Integer; + function GetProxyError: string; procedure SetConnectStatus(const AValue: TConnectStatus); procedure SetLastNetError(const AValue: Integer); @@ -366,6 +368,10 @@ TIoEventThread = class; /// 上层在连接失败回调中读取, 用于生成带有具体 WSA/errno 错误码的诊断日志 /// property LastNetError: Integer read GetLastNetError write SetLastNetError; + /// + /// 代理握手失败的协议级错误信息, 由上层连接失败回调读取 + /// + property ProxyError: string read GetProxyError; end; TCrossConnections = TDictionary; @@ -716,6 +722,12 @@ TCrossConnectionBase = class(TCrossData, ICrossConnection) FLastNetError: Integer; FRecvLock, FSentLock: ILock; FConnectCb: TCrossConnectionCallback; + FProxySettings: TCrossProxySettings; + FProxyTargetHost: string; + FProxyTargetPort: Word; + FProxyStage: Integer; + FProxyBuffer: TBytes; + FProxyError: string; protected procedure _LockRecv; inline; procedure _UnlockRecv; inline; @@ -730,12 +742,25 @@ TCrossConnectionBase = class(TCrossData, ICrossConnection) function GetConnectType: TConnectType; function GetConnectStatus: TConnectStatus; function GetLastNetError: Integer; + function GetProxyError: string; function GetIsClosed: Boolean; override; function _SetConnectStatus(const AStatus: TConnectStatus): TConnectStatus; inline; procedure SetConnectStatus(const AValue: TConnectStatus); procedure SetLastNetError(const AValue: Integer); + public + procedure ConfigureProxy(const ASettings: TCrossProxySettings; + const ATargetHost: string; const ATargetPort: Word); + function ProxyUsesTlsTransport: Boolean; + function ProxySettings: TCrossProxySettings; + function ProxyError: string; + function ProxyNeedsHandshake: Boolean; + function ProxyStart(out ASendData: TBytes): Boolean; + function ProxyFeed(const ABuf: Pointer; const ALen: Integer; + out ASendData, ARemain: TBytes): TCrossProxyFeedResult; + + protected procedure InternalClose; virtual; procedure DirectSend(const ABuffer: Pointer; const ACount: Integer; const ACallback: TCrossConnectionCallback = nil); virtual; @@ -861,6 +886,9 @@ TCrossSocketBase = class abstract(TInterfacedObject, ICrossSocket) function CreateListen(const AOwner: TCrossSocketBase; const AListenSocket: TSocket; const AFamily, ASockType, AProtocol: Integer): ICrossListen; virtual; abstract; + procedure PrepareConnection(const AConnection: ICrossConnection; + const ALogicalHost: string; const ALogicalPort: Word); virtual; + {$region '物理事件'} procedure TriggerListened(const AListen: ICrossListen); virtual; procedure TriggerListenEnd(const AListen: ICrossListen); virtual; @@ -896,6 +924,10 @@ TCrossSocketBase = class abstract(TInterfacedObject, ICrossSocket) procedure Connect(const AHost: string; const APort, ALocalPort: Word; const ACallback: TCrossConnectionCallback = nil); overload; virtual; abstract; + procedure ConnectTarget(const APhysicalHost: string; + const APhysicalPort, ALocalPort: Word; const ALogicalHost: string; + const ALogicalPort: Word; + const ACallback: TCrossConnectionCallback = nil); virtual; abstract; procedure Connect(const AHost: string; const APort: Word; const ACallback: TCrossConnectionCallback = nil); overload; @@ -1121,6 +1153,12 @@ function TCrossSocketBase.CreateConnection(const AOwner: TCrossSocketBase; Result := CreateConnection(AOwner, AClientSocket, AConnectType, AHost, nil); end; +procedure TCrossSocketBase.PrepareConnection( + const AConnection: ICrossConnection; const ALogicalHost: string; + const ALogicalPort: Word); +begin +end; + destructor TCrossSocketBase.Destroy; begin FreeAndNil(FListens); @@ -1367,9 +1405,17 @@ procedure TCrossSocketBase.TriggerConnecting(const AConnection: ICrossConnection procedure TCrossSocketBase.TriggerConnected(const AConnection: ICrossConnection); var LConnObj: TCrossConnectionBase; + LProxyData: TBytes; begin LConnObj := AConnection as TCrossConnectionBase; + if LConnObj.ProxyNeedsHandshake then + begin + if LConnObj.ProxyStart(LProxyData) then + LConnObj.SendBytes(LProxyData); + Exit; + end; + LConnObj._Lock; try AConnection.UpdateAddr; @@ -1460,12 +1506,31 @@ procedure TCrossSocketBase.TriggerReceived(const AConnection: ICrossConnection; const ABuf: Pointer; const ALen: Integer); var LConnObj: TCrossConnectionBase; + LProxyResult: TCrossProxyFeedResult; + LProxyData, LRemain: TBytes; begin LConnObj := AConnection as TCrossConnectionBase; LConnObj._LockRecv; try - LogicReceived(AConnection, ABuf, ALen); + if LConnObj.ProxyNeedsHandshake then + begin + LProxyResult := LConnObj.ProxyFeed(ABuf, ALen, LProxyData, LRemain); + case LProxyResult of + cpfrSendData: + LConnObj.SendBytes(LProxyData); + cpfrComplete: + begin + TriggerConnected(AConnection); + if Length(LRemain) > 0 then + LogicReceived(AConnection, @LRemain[0], Length(LRemain)); + end; + cpfrFailed: + LConnObj.Close; + end; + end + else + LogicReceived(AConnection, ABuf, ALen); finally LConnObj._UnlockRecv; end; @@ -1805,6 +1870,195 @@ function TCrossConnectionBase.GetLastNetError: Integer; Result := AtomicCmpExchange(FLastNetError, 0, 0); end; +procedure TCrossConnectionBase.ConfigureProxy( + const ASettings: TCrossProxySettings; const ATargetHost: string; + const ATargetPort: Word); +begin + FProxySettings := ASettings; + FProxyTargetHost := ATargetHost; + FProxyTargetPort := ATargetPort; + FProxyBuffer := nil; + FProxyStage := 0; + + if not ASettings.IsEnabled or ASettings.ShouldBypass(ATargetHost) then + Exit; + + if ASettings.UsesHttpConnect then + FProxyStage := 1 + else + if ASettings.ProxyType = cptSocks4 then + FProxyStage := 2 + else + if ASettings.ProxyType = cptSocks5 then + FProxyStage := 3; +end; + +function TCrossConnectionBase.ProxyNeedsHandshake: Boolean; +begin + Result := FProxyStage <> 0; +end; + +function TCrossConnectionBase.ProxyUsesTlsTransport: Boolean; +begin + Result := FProxySettings.UsesTlsProxyTransport; +end; + +function TCrossConnectionBase.ProxySettings: TCrossProxySettings; +begin + Result := FProxySettings; +end; + +function TCrossConnectionBase.ProxyError: string; +begin + Result := FProxyError; +end; + +function TCrossConnectionBase.GetProxyError: string; +begin + Result := FProxyError; +end; + +function TCrossConnectionBase.ProxyStart(out ASendData: TBytes): Boolean; +begin + ASendData := nil; + if FProxyStage = 0 then + Exit(False); + + case FProxyStage of + 1: + ASendData := TCrossProxyCodec.BuildHttpConnect( + FProxyTargetHost, FProxyTargetPort, + FProxySettings.Username, FProxySettings.Password); + 2: + ASendData := TCrossProxyCodec.BuildSocks4Connect( + FProxyTargetHost, FProxyTargetPort, FProxySettings.Username); + 3: + ASendData := TCrossProxyCodec.BuildSocks5Greeting( + (FProxySettings.Username <> '') or (FProxySettings.Password <> '')); + else + Exit(False); + end; + + Result := Length(ASendData) > 0; +end; + +function TCrossConnectionBase.ProxyFeed(const ABuf: Pointer; + const ALen: Integer; out ASendData, ARemain: TBytes): TCrossProxyFeedResult; +var + LConsumed, LStatus: Integer; + LMethod: Byte; + LSuccess: Boolean; + LBytes: TBytes; +begin + ASendData := nil; + ARemain := nil; + if (ABuf = nil) or (ALen <= 0) then + Exit(cpfrNeedData); + + LBytes := FProxyBuffer; + SetLength(FProxyBuffer, Length(LBytes) + ALen); + Move(ABuf^, FProxyBuffer[Length(LBytes)], ALen); + + case FProxyStage of + 1: + begin + if not TCrossProxyCodec.TryParseHttpConnectResponse( + FProxyBuffer, LConsumed, LStatus) then + Exit(cpfrNeedData); + if (LStatus < 200) or (LStatus >= 300) then + begin + // 保留代理返回的认证状态, 避免上层只能看到笼统的 Connect failed。 + if LStatus = 407 then + FProxyError := 'HTTP proxy authentication failed (407 Proxy Authentication Required)' + else + FProxyError := Format('HTTP proxy CONNECT failed with status %d', [LStatus]); + Exit(cpfrFailed); + end; + ARemain := Copy(FProxyBuffer, LConsumed, MaxInt); + FProxyBuffer := nil; + FProxyError := ''; + FProxyStage := 0; + Exit(cpfrComplete); + end; + 2: + begin + if not TCrossProxyCodec.TryParseSocks4Response( + FProxyBuffer, LConsumed, LSuccess) then + Exit(cpfrNeedData); + if not LSuccess then + Exit(cpfrFailed); + ARemain := Copy(FProxyBuffer, LConsumed, MaxInt); + FProxyBuffer := nil; + FProxyStage := 0; + Exit(cpfrComplete); + end; + 3: + begin + if not TCrossProxyCodec.TryParseSocks5MethodResponse( + FProxyBuffer, LConsumed, LMethod) then + Exit(cpfrNeedData); + FProxyBuffer := Copy(FProxyBuffer, LConsumed, MaxInt); + if LMethod = 0 then + begin + ASendData := TCrossProxyCodec.BuildSocks5Connect( + FProxyTargetHost, FProxyTargetPort); + FProxyStage := 5; + end + else + if LMethod = 2 then + begin + ASendData := TCrossProxyCodec.BuildSocks5Auth( + FProxySettings.Username, FProxySettings.Password); + FProxyStage := 4; + end + else + begin + // SOCKS5 返回 $FF 表示代理不接受客户端提供的任何认证方式。 + if LMethod = $FF then + FProxyError := 'SOCKS5 proxy authentication failed: no acceptable authentication method' + else + FProxyError := Format('SOCKS5 proxy authentication method %d is not supported', [LMethod]); + Exit(cpfrFailed); + end; + Exit(cpfrSendData); + end; + 4: + begin + if not TCrossProxyCodec.TryParseSocks5AuthResponse( + FProxyBuffer, LConsumed, LSuccess) then + Exit(cpfrNeedData); + if not LSuccess then + begin + // 用户名密码校验失败必须在连接对象销毁前保存, 供上层回调读取。 + FProxyError := 'SOCKS5 proxy username/password authentication failed'; + Exit(cpfrFailed); + end; + FProxyBuffer := Copy(FProxyBuffer, LConsumed, MaxInt); + ASendData := TCrossProxyCodec.BuildSocks5Connect( + FProxyTargetHost, FProxyTargetPort); + FProxyStage := 5; + Exit(cpfrSendData); + end; + 5: + begin + if not TCrossProxyCodec.TryParseSocks5ConnectResponse( + FProxyBuffer, LConsumed, LSuccess) then + Exit(cpfrNeedData); + if not LSuccess then + begin + FProxyError := 'SOCKS5 proxy CONNECT request failed'; + Exit(cpfrFailed); + end; + ARemain := Copy(FProxyBuffer, LConsumed, MaxInt); + FProxyBuffer := nil; + FProxyStage := 0; + Exit(cpfrComplete); + end; + end; + + Result := cpfrFailed; +end; + procedure TCrossConnectionBase.SetLastNetError(const AValue: Integer); begin AtomicExchange(FLastNetError, AValue); diff --git a/Net/Net.CrossSocket.Epoll.pas b/Net/Net.CrossSocket.Epoll.pas index 121a896..70d0597 100644 --- a/Net/Net.CrossSocket.Epoll.pas +++ b/Net/Net.CrossSocket.Epoll.pas @@ -158,8 +158,12 @@ TEpollCrossSocket = class(TCrossSocketBase) procedure Listen(const AHost: string; const APort: Word; const ACallback: TCrossListenCallback = nil); override; - procedure Connect(const AHost: string; const APort, ALocalPort: Word; - const ACallback: TCrossConnectionCallback = nil); override; + procedure Connect(const AHost: string; const APort, ALocalPort: Word; + const ACallback: TCrossConnectionCallback = nil); override; + procedure ConnectTarget(const APhysicalHost: string; + const APhysicalPort, ALocalPort: Word; const ALogicalHost: string; + const ALogicalPort: Word; + const ACallback: TCrossConnectionCallback = nil); override; procedure Send(const AConnection: ICrossConnection; const ABuf: Pointer; const ALen: Integer; const ACallback: TCrossConnectionCallback = nil); override; @@ -673,8 +677,15 @@ procedure TEpollCrossSocket.StopLoop; _CloseStopHandle; end; -procedure TEpollCrossSocket.Connect(const AHost: string; - const APort, ALocalPort: Word; const ACallback: TCrossConnectionCallback); +procedure TEpollCrossSocket.Connect(const AHost: string; + const APort, ALocalPort: Word; const ACallback: TCrossConnectionCallback); +begin + ConnectTarget(AHost, APort, ALocalPort, AHost, APort, ACallback); +end; + +procedure TEpollCrossSocket.ConnectTarget(const APhysicalHost: string; + const APhysicalPort, ALocalPort: Word; const ALogicalHost: string; + const ALogicalPort: Word; const ACallback: TCrossConnectionCallback); procedure _Failed1; begin @@ -717,8 +728,9 @@ procedure TEpollCrossSocket.Connect(const AHost: string; if (TSocketAPI.Connect(ASocket, AAddr.ai_addr, AAddr.ai_addrlen) = 0) or (GetLastError = EINPROGRESS) then begin - LConnection := CreateConnection(Self, ASocket, ctConnect, AHost, ACallback); - TriggerConnecting(LConnection); + LConnection := CreateConnection(Self, ASocket, ctConnect, ALogicalHost, ACallback); + PrepareConnection(LConnection, ALogicalHost, ALogicalPort); + TriggerConnecting(LConnection); LEpConnection := LConnection as TEpollConnection; LEpConnection._EpLock; @@ -752,7 +764,7 @@ procedure TEpollCrossSocket.Connect(const AHost: string; LHints.ai_family := AF_UNSPEC; LHints.ai_socktype := SOCK_STREAM; LHints.ai_protocol := IPPROTO_TCP; - LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints); + LAddrInfo := TSocketAPI.GetAddrInfo(APhysicalHost, APhysicalPort, LHints); if (LAddrInfo = nil) then begin _Failed1; diff --git a/Net/Net.CrossSocket.Iocp.pas b/Net/Net.CrossSocket.Iocp.pas index 1e9523c..39be1b2 100644 --- a/Net/Net.CrossSocket.Iocp.pas +++ b/Net/Net.CrossSocket.Iocp.pas @@ -96,8 +96,12 @@ TPerIoData = record procedure Listen(const AHost: string; const APort: Word; const ACallback: TCrossListenCallback = nil); override; - procedure Connect(const AHost: string; const APort, ALocalPort: Word; - const ACallback: TCrossConnectionCallback = nil); override; + procedure Connect(const AHost: string; const APort, ALocalPort: Word; + const ACallback: TCrossConnectionCallback = nil); override; + procedure ConnectTarget(const APhysicalHost: string; + const APhysicalPort, ALocalPort: Word; const ALogicalHost: string; + const ALogicalPort: Word; + const ACallback: TCrossConnectionCallback = nil); override; procedure Send(const AConnection: ICrossConnection; const ABuf: Pointer; const ALen: Integer; const ACallback: TCrossConnectionCallback = nil); override; @@ -466,9 +470,16 @@ procedure TIocpCrossSocket.StopLoop; CloseHandle(FIocpHandle); end; -procedure TIocpCrossSocket.Connect(const AHost: string; - const APort, ALocalPort: Word; const ACallback: TCrossConnectionCallback); -var +procedure TIocpCrossSocket.Connect(const AHost: string; + const APort, ALocalPort: Word; const ACallback: TCrossConnectionCallback); +begin + ConnectTarget(AHost, APort, ALocalPort, AHost, APort, ACallback); +end; + +procedure TIocpCrossSocket.ConnectTarget(const APhysicalHost: string; + const APhysicalPort, ALocalPort: Word; const ALogicalHost: string; + const ALogicalPort: Word; const ACallback: TCrossConnectionCallback); +var LHints: TRawAddrInfo; P, LAddrInfo: PRawAddrInfo; LSocket: TSocket; @@ -517,8 +528,9 @@ procedure TIocpCrossSocket.Connect(const AHost: string; Exit(False); end; - LConnection := CreateConnection(Self, ASocket, ctConnect, AHost, ACallback); - TriggerConnecting(LConnection); + LConnection := CreateConnection(Self, ASocket, ctConnect, ALogicalHost, ACallback); + PrepareConnection(LConnection, ALogicalHost, ALogicalPort); + TriggerConnecting(LConnection); LPerIoData := _NewIoData; LPerIoData.Action := ioConnect; @@ -545,7 +557,7 @@ procedure TIocpCrossSocket.Connect(const AHost: string; LHints.ai_family := AF_UNSPEC; LHints.ai_socktype := SOCK_STREAM; LHints.ai_protocol := IPPROTO_TCP; - LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints); + LAddrInfo := TSocketAPI.GetAddrInfo(APhysicalHost, APhysicalPort, LHints); if (LAddrInfo = nil) then begin _LogLastOsError(Self.ClassName + '.Connect.GetAddrInfo'); diff --git a/Net/Net.CrossSocket.Kqueue.pas b/Net/Net.CrossSocket.Kqueue.pas index c0f76a7..7f6e0fc 100644 --- a/Net/Net.CrossSocket.Kqueue.pas +++ b/Net/Net.CrossSocket.Kqueue.pas @@ -186,8 +186,12 @@ TKqueueCrossSocket = class(TCrossSocketBase) procedure Listen(const AHost: string; const APort: Word; const ACallback: TCrossListenCallback = nil); override; - procedure Connect(const AHost: string; const APort, ALocalPort: Word; - const ACallback: TCrossConnectionCallback = nil); override; + procedure Connect(const AHost: string; const APort, ALocalPort: Word; + const ACallback: TCrossConnectionCallback = nil); override; + procedure ConnectTarget(const APhysicalHost: string; + const APhysicalPort, ALocalPort: Word; const ALogicalHost: string; + const ALogicalPort: Word; + const ACallback: TCrossConnectionCallback = nil); override; procedure Send(const AConnection: ICrossConnection; const ABuf: Pointer; const ALen: Integer; const ACallback: TCrossConnectionCallback = nil); override; @@ -775,8 +779,15 @@ procedure TKqueueCrossSocket.StopLoop; _CloseStopHandle; end; -procedure TKqueueCrossSocket.Connect(const AHost: string; - const APort, ALocalPort: Word; const ACallback: TCrossConnectionCallback); +procedure TKqueueCrossSocket.Connect(const AHost: string; + const APort, ALocalPort: Word; const ACallback: TCrossConnectionCallback); +begin + ConnectTarget(AHost, APort, ALocalPort, AHost, APort, ACallback); +end; + +procedure TKqueueCrossSocket.ConnectTarget(const APhysicalHost: string; + const APhysicalPort, ALocalPort: Word; const ALogicalHost: string; + const ALogicalPort: Word; const ACallback: TCrossConnectionCallback); procedure _Failed1; begin @@ -819,8 +830,9 @@ procedure TKqueueCrossSocket.Connect(const AHost: string; if (TSocketAPI.Connect(ASocket, AAddr.ai_addr, AAddr.ai_addrlen) = 0) or (GetLastError = EINPROGRESS) then begin - LConnection := CreateConnection(Self, ASocket, ctConnect, AHost, ACallback); - TriggerConnecting(LConnection); + LConnection := CreateConnection(Self, ASocket, ctConnect, ALogicalHost, ACallback); + PrepareConnection(LConnection, ALogicalHost, ALogicalPort); + TriggerConnecting(LConnection); LKqConnection := LConnection as TKqueueConnection; LKqConnection._KqLock; @@ -852,7 +864,7 @@ procedure TKqueueCrossSocket.Connect(const AHost: string; LHints.ai_family := AF_UNSPEC; LHints.ai_socktype := SOCK_STREAM; LHints.ai_protocol := IPPROTO_TCP; - LAddrInfo := TSocketAPI.GetAddrInfo(AHost, APort, LHints); + LAddrInfo := TSocketAPI.GetAddrInfo(APhysicalHost, APhysicalPort, LHints); if (LAddrInfo = nil) then begin _Failed1; diff --git a/Net/Net.CrossSslSocket.Base.pas b/Net/Net.CrossSslSocket.Base.pas index 7705ba3..4f62ce6 100644 --- a/Net/Net.CrossSslSocket.Base.pas +++ b/Net/Net.CrossSslSocket.Base.pas @@ -229,6 +229,7 @@ TCrossSslListenBase = class(TCrossListen); TCrossSslConnectionBase = class(TCrossConnection, ICrossSslConnection) protected function GetSsl: Boolean; + procedure SendProxyBytes(const ABytes: TBytes); virtual; abstract; public function GetSslInfo(var ASslInfo: TSslInfo): Boolean; virtual; diff --git a/Net/Net.CrossSslSocket.MbedTls.pas b/Net/Net.CrossSslSocket.MbedTls.pas index 23c0de7..61f034c 100644 --- a/Net/Net.CrossSslSocket.MbedTls.pas +++ b/Net/Net.CrossSslSocket.MbedTls.pas @@ -28,6 +28,7 @@ interface Classes, Net.SocketAPI, + Net.CrossProxy, Net.CrossSocket.Base, Net.CrossSocket, Net.CrossSslSocket.Base, @@ -104,6 +105,7 @@ TCrossMbedTlsConnection = class(TCrossSslConnectionBase) protected procedure DirectSend(const ABuffer: Pointer; const ACount: Integer; const ACallback: TCrossConnectionCallback = nil); override; + procedure SendProxyBytes(const ABytes: TBytes); override; public constructor Create(const AOwner: TCrossSocketBase; const AClientSocket: TSocket; const AConnectType: TConnectType; @@ -297,6 +299,21 @@ constructor TCrossMbedTlsConnection.Create(const AOwner: TCrossSocketBase; end; end; +procedure TCrossMbedTlsConnection.SendProxyBytes(const ABytes: TBytes); +var + LBytes: TBytes; +begin + if Length(ABytes) = 0 then + Exit; + + LBytes := ABytes; + inherited DirectSend(@LBytes[0], Length(LBytes), + procedure(const AConnection: ICrossConnection; const ASuccess: Boolean) + begin + LBytes := nil; + end); +end; + destructor TCrossMbedTlsConnection.Destroy; begin if Ssl then @@ -564,9 +581,24 @@ procedure TCrossMbedTlsSocket.SetPrivateKey(const APKeyBytes: TBytes; procedure TCrossMbedTlsSocket.TriggerConnected(const AConnection: ICrossConnection); var LConnection: TCrossMbedTlsConnection; + LProxyData: TBytes; begin LConnection := AConnection as TCrossMbedTlsConnection; + if LConnection.ProxyUsesTlsTransport then + begin + _Log('HTTPS proxy TLS transport requires the OpenSSL backend.'); + LConnection.Close; + Exit; + end; + + if LConnection.ProxyNeedsHandshake then + begin + if LConnection.ProxyStart(LProxyData) then + LConnection.SendProxyBytes(LProxyData); + Exit; + end; + if Ssl then begin // 网络连接已建立, 等待握手 @@ -586,9 +618,29 @@ procedure TCrossMbedTlsSocket.TriggerReceived(const AConnection: ICrossConnectio var LConnection: TCrossMbedTlsConnection; LRetCode: Integer; + LProxyData, LRemain: TBytes; + LProxyResult: TCrossProxyFeedResult; begin LConnection := AConnection as TCrossMbedTlsConnection; + if LConnection.ProxyNeedsHandshake then + begin + LProxyResult := LConnection.ProxyFeed(ABuf, ALen, LProxyData, LRemain); + case LProxyResult of + cpfrSendData: + LConnection.SendProxyBytes(LProxyData); + cpfrComplete: + begin + TriggerConnected(AConnection); + if Length(LRemain) > 0 then + TriggerReceived(AConnection, @LRemain[0], Length(LRemain)); + end; + cpfrFailed: + LConnection.Close; + end; + Exit; + end; + if Ssl then begin LConnection._Lock; diff --git a/Net/Net.CrossSslSocket.OpenSSL.pas b/Net/Net.CrossSslSocket.OpenSSL.pas index 9064e09..0bcd88e 100644 --- a/Net/Net.CrossSslSocket.OpenSSL.pas +++ b/Net/Net.CrossSslSocket.OpenSSL.pas @@ -29,6 +29,7 @@ interface Generics.Collections, Net.SocketAPI, + Net.CrossProxy, Net.CrossSocket.Base, Net.CrossSocket, Net.CrossSslSocket.Types, @@ -56,6 +57,10 @@ TPendingWrite = record private FSslData: PSSL; FBIOIn, FBIOOut: PBIO; + FProxySslData: PSSL; + FProxyBIOIn, FProxyBIOOut: PBIO; + FProxyTlsStarted: Boolean; + FProxyTlsReady: Boolean; FLock: ILock; // 握手阶段累计输入字节数: 仅在 csHandshaking 时累加, 超过 // MAX_HANDSHAKE_RECV_BYTES 即视作 DoS 主动 fatal close. 防御 @@ -79,6 +84,8 @@ TPendingWrite = record function _BIO_read(Buf: Pointer; Len: Integer): Integer; inline; function _BIO_read_all: TBytes; overload; function _BIO_write(Buf: Pointer; Len: Integer): Integer; inline; + function _BIO_read_all(const ABIO: PBIO): TBytes; overload; + function _SSL_read_all(const ASslData: PSSL): TBytes; overload; function _SSL_read(Buf: Pointer; Len: Integer): Integer; overload; inline; function _SSL_read_all: TBytes; overload; @@ -115,6 +122,14 @@ TPendingWrite = record // 其他路径传 Self as ICrossConnection. procedure _DrainPendingWritesAsFailed(const AConnection: ICrossConnection); + procedure _RawSend(const ABytes: TBytes; + const ACallback: TCrossConnectionCallback = nil); + procedure _ProxyTlsSend(const ABuffer: Pointer; const ACount: Integer; + const ACallback: TCrossConnectionCallback = nil); + function _StartProxyTls(out AHandshakeData: TBytes): Boolean; + function _FeedProxyTls(const ABuf: Pointer; const ALen: Integer; + out APlainData, AHandshakeData: TBytes; out AHandshakeCompleted: Boolean): Boolean; + procedure _Send(const ABuffer: Pointer; const ACount: Integer; const ACallback: TCrossConnectionCallback = nil); overload; procedure _Send(const ABytes: TBytes; @@ -122,6 +137,9 @@ TPendingWrite = record protected procedure DirectSend(const ABuffer: Pointer; const ACount: Integer; const ACallback: TCrossConnectionCallback = nil); override; + procedure SendProxyBytes(const ABytes: TBytes); override; + function ProxyTlsStarted: Boolean; + function ProxyTlsReady: Boolean; public constructor Create(const AOwner: TCrossSocketBase; const AClientSocket: TSocket; const AConnectType: TConnectType; const AHost: string; @@ -140,6 +158,7 @@ TPendingWrite = record TCrossOpenSslSocket = class(TCrossSslSocketBase) private FSslCtx: PSSL_CTX; + FTlsRuntimeLoaded: Boolean; procedure _InitSslCtx; procedure _FreeSslCtx; @@ -153,6 +172,11 @@ TCrossOpenSslSocket = class(TCrossSslSocketBase) const AConnectionObj: TCrossOpenSslConnection; const ATriggerConnected: Boolean; var ADecryptedData: TBytes; const AFatal: Boolean); + procedure _ProcessReceivedPayload(const AConnection: ICrossConnection; + const APayload: Pointer; const APayloadLen: Integer); + procedure _FinishProxyTlsReceive(const AConnection: ICrossConnection; + const ASuccess: Boolean; const APlainData: TBytes; + const AHandshakeCompleted: Boolean); protected procedure ApplyVerifyPeer(const AValue: Boolean); override; procedure TriggerConnected(const AConnection: ICrossConnection); override; @@ -170,6 +194,7 @@ TCrossOpenSslSocket = class(TCrossSslSocketBase) const ASize: Integer); overload; override; procedure SetPrivateKey(const APKeyBuf: Pointer; const APKeyBufSize: Integer; const APassword: string); overload; override; + procedure EnsureSslCtx; end; {$IFDEF CROSS_OPENSSL_SELFTEST} @@ -356,26 +381,46 @@ constructor TCrossOpenSslConnection.Create(const AOwner: TCrossSocketBase; end; end; +procedure TCrossOpenSslConnection.SendProxyBytes(const ABytes: TBytes); +begin + _Send(ABytes); +end; + +function TCrossOpenSslConnection.ProxyTlsStarted: Boolean; +begin + Result := FProxyTlsStarted; +end; + +function TCrossOpenSslConnection.ProxyTlsReady: Boolean; +begin + Result := FProxyTlsReady; +end; + destructor TCrossOpenSslConnection.Destroy; begin - if Ssl then + if (FPendingWrites <> nil) then begin // pending writes 析构 drain: 把所有挂起 callback 以 fail 通知上层, // 上层闭包持有的 TBytes 才能释放 (零拷贝契约). 传 nil connection 避免 // (Self as ICrossConnection) 引起的 refcount 环 → 二次析构. - if (FPendingWrites <> nil) then - begin - _DrainPendingWritesAsFailed(nil); - FPendingWrites.Free; - end; + _DrainPendingWritesAsFailed(nil); + FPendingWrites.Free; + end; - if (FSslData <> nil) then - begin - if (SSL_shutdown(FSslData) = 0) then - SSL_shutdown(FSslData); - SSL_free(FSslData); - FSslData := nil; - end; + if (FSslData <> nil) then + begin + if (SSL_shutdown(FSslData) = 0) then + SSL_shutdown(FSslData); + SSL_free(FSslData); + FSslData := nil; + end; + + if (FProxySslData <> nil) then + begin + if FProxyTlsReady and (SSL_shutdown(FProxySslData) = 0) then + SSL_shutdown(FProxySslData); + SSL_free(FProxySslData); + FProxySslData := nil; end; inherited Destroy; @@ -397,6 +442,8 @@ function TCrossOpenSslConnection.GetSslInfo(var ASslInfo: TSslInfo): Boolean; procedure TCrossOpenSslConnection._SslLock; begin + if FLock = nil then + FLock := TLock.Create; FLock.Enter; end; @@ -416,6 +463,11 @@ function TCrossOpenSslConnection._BIO_read(Buf: Pointer; Len: Integer): Integer; end; function TCrossOpenSslConnection._BIO_read_all: TBytes; +begin + Result := _BIO_read_all(FBIOOut); +end; + +function TCrossOpenSslConnection._BIO_read_all(const ABIO: PBIO): TBytes; const INITIAL_BUF_SIZE = 16384; // 初始缓冲区大小 16KB MAX_BUF_INCREMENT = 65536; // 最大增量 64KB @@ -431,7 +483,7 @@ function TCrossOpenSslConnection._BIO_read_all: TBytes; while True do begin // 获取当前可读数据量 - LBlockSize := _BIO_pending; + LBlockSize := BIO_pending(ABIO); if (LBlockSize <= 0) then Break; // 计算缓冲区剩余空间 @@ -453,7 +505,7 @@ function TCrossOpenSslConnection._BIO_read_all: TBytes; P := PByte(@Result[0]) + LReadedCount; // 从 BIO 读取数据(最多读取 LBlockSize) - LRetCode := _BIO_read(P, LBlockSize); + LRetCode := BIO_read(ABIO, P, LBlockSize); // BIO_read 返回 <= 0 表示没有更多数据可读 // 对于内存 BIO，这是正常情况，不需要错误处理 @@ -480,6 +532,12 @@ function TCrossOpenSslConnection._SSL_read(Buf: Pointer; Len: Integer): Integer; end; function TCrossOpenSslConnection._SSL_read_all: TBytes; +begin + Result := _SSL_read_all(FSslData); +end; + +function TCrossOpenSslConnection._SSL_read_all( + const ASslData: PSSL): TBytes; const INITIAL_BUF_SIZE = 16384; // 初始缓冲区 16KB MAX_BUF_INCREMENT = 65536; // 最大增量 64KB @@ -512,13 +570,13 @@ function TCrossOpenSslConnection._SSL_read_all: TBytes; P := PByte(@Result[0]) + LReadedCount; // 读取数据 - LRetCode := _SSL_read(P, LFreeSpace); + LRetCode := SSL_read(ASslData, P, LFreeSpace); // 直到读不到数据为止 if (LRetCode <= 0) then begin - // 随便记录一下, 不一定有错误 - _SSL_handle_error(LRetCode, 'SSL_read'); + if SSL_is_fatal_error(SSL_get_error(ASslData, LRetCode)) then + _Log('SSL_read ' + GetOpenSslErrors); Break; end; @@ -570,10 +628,199 @@ function TCrossOpenSslConnection._SSL_handle_error(const ARetCode: Integer; Result := _SSL_handle_error(ARetCode, AOperation, LError); end; +function TCrossOpenSslConnection._StartProxyTls( + out AHandshakeData: TBytes): Boolean; +var + LHostAnsi: AnsiString; + LRetCode: Integer; +begin + Result := False; + AHandshakeData := nil; + if not ProxyUsesTlsTransport or FProxyTlsStarted then + Exit; + + TCrossOpenSslSocket(Owner).EnsureSslCtx; + TCrossOpenSslSocket(Owner).LockTlsConfiguration; + _SslLock; + try + FProxyTlsStarted := True; + FProxySslData := SSL_new(TCrossOpenSslSocket(Owner).FSslCtx); + if FProxySslData = nil then + raise ECrossSocket.Create('SSL_new for HTTPS proxy failed.'); + + FProxyBIOIn := BIO_new(BIO_s_mem()); + FProxyBIOOut := BIO_new(BIO_s_mem()); + if (FProxyBIOIn = nil) or (FProxyBIOOut = nil) then + begin + if FProxyBIOIn <> nil then + BIO_free(FProxyBIOIn); + if FProxyBIOOut <> nil then + BIO_free(FProxyBIOOut); + FProxyBIOIn := nil; + FProxyBIOOut := nil; + SSL_free(FProxySslData); + FProxySslData := nil; + raise ECrossSocket.Create('BIO_new for HTTPS proxy failed.'); + end; + SSL_set_bio(FProxySslData, FProxyBIOIn, FProxyBIOOut); + + SSL_set_connect_state(FProxySslData); + LHostAnsi := AnsiString(ProxySettings.Host); + SSL_set_tlsext_host_name(FProxySslData, MarshaledAString(LHostAnsi)); + if TCrossOpenSslSocket(Owner).VerifyPeer then + begin + if LHostAnsi = '' then + raise ECrossSocket.Create( + 'A HTTPS proxy host name is required when peer verification is enabled.'); + ClearOpenSslErrors; + if SSL_set1_host(FProxySslData, PAnsiChar(LHostAnsi)) <= 0 then + raise ECrossSocket.CreateFmt('SSL_set1_host for HTTPS proxy failed: %s.', + [GetOpenSslErrors]); + end; + + LRetCode := SSL_do_handshake(FProxySslData); + if (LRetCode <> 1) and SSL_is_fatal_error( + SSL_get_error(FProxySslData, LRetCode)) then + raise ECrossSocket.CreateFmt('HTTPS proxy TLS handshake failed: %s.', + [GetOpenSslErrors]); + AHandshakeData := _BIO_read_all(FProxyBIOOut); + Result := Length(AHandshakeData) > 0; + if not Result then + raise ECrossSocket.CreateFmt( + 'HTTPS proxy TLS produced no handshake bytes (ret=%d): %s', + [LRetCode, GetOpenSslErrors]); + finally + _SslUnlock; + end; +end; + +function TCrossOpenSslConnection._FeedProxyTls(const ABuf: Pointer; + const ALen: Integer; out APlainData, AHandshakeData: TBytes; + out AHandshakeCompleted: Boolean): Boolean; +var + LRetCode: Integer; +begin + Result := False; + APlainData := nil; + AHandshakeData := nil; + AHandshakeCompleted := False; + if (not FProxyTlsStarted) or (FProxySslData = nil) or + (ABuf = nil) or (ALen <= 0) then + Exit; + + _SslLock; + try + LRetCode := BIO_write(FProxyBIOIn, ABuf, ALen); + if LRetCode <> ALen then + Exit; + + if not FProxyTlsReady then + begin + LRetCode := SSL_do_handshake(FProxySslData); + if (LRetCode <> 1) and SSL_is_fatal_error( + SSL_get_error(FProxySslData, LRetCode)) then + begin + _Log('HTTPS proxy TLS handshake failed: ' + GetOpenSslErrors); + Exit; + end; + AHandshakeData := _BIO_read_all(FProxyBIOOut); + if SSL_is_init_finished(FProxySslData) = 0 then + begin + Result := True; + Exit; + end; + FProxyTlsReady := True; + AHandshakeCompleted := True; + end; + + APlainData := _SSL_read_all(FProxySslData); + Result := True; + finally + _SslUnlock; + end; +end; + +procedure TCrossOpenSslConnection._RawSend(const ABytes: TBytes; + const ACallback: TCrossConnectionCallback); +var + LBytes: TBytes; +begin + if Length(ABytes) = 0 then + begin + if Assigned(ACallback) then + ACallback(Self, True); + Exit; + end; + + LBytes := ABytes; + inherited DirectSend(@LBytes[0], Length(LBytes), + procedure(const AConnection: ICrossConnection; const ASuccess: Boolean) + begin + LBytes := nil; + if Assigned(ACallback) then + ACallback(AConnection, ASuccess); + end); +end; + +procedure TCrossOpenSslConnection._ProxyTlsSend(const ABuffer: Pointer; + const ACount: Integer; const ACallback: TCrossConnectionCallback); +var + LRetCode, LWritten: Integer; + LEncryptedData: TBytes; + LFatal: Boolean; +begin + if (ACount <= 0) then + begin + if Assigned(ACallback) then + ACallback(Self, True); + Exit; + end; + + LEncryptedData := nil; + LFatal := False; + LWritten := 0; + _SslLock; + try + LRetCode := SSL_write(FProxySslData, ABuffer, ACount); + if LRetCode > 0 then + LWritten := LRetCode + else + LFatal := SSL_is_fatal_error(SSL_get_error(FProxySslData, LRetCode)); + LEncryptedData := _BIO_read_all(FProxyBIOOut); + finally + _SslUnlock; + end; + + if LFatal or (LEncryptedData = nil) then + begin + if Assigned(ACallback) then + ACallback(Self, False); + Exit; + end; + + _RawSend(LEncryptedData, + procedure(const AConnection: ICrossConnection; const ASuccess: Boolean) + begin + if not ASuccess then + begin + if Assigned(ACallback) then + ACallback(AConnection, False); + Exit; + end; + if LWritten < ACount then + _ProxyTlsSend(PByte(ABuffer) + LWritten, ACount - LWritten, ACallback) + else if Assigned(ACallback) then + ACallback(AConnection, True); + end); +end; + procedure TCrossOpenSslConnection._Send(const ABuffer: Pointer; const ACount: Integer; const ACallback: TCrossConnectionCallback); begin - inherited DirectSend(ABuffer, ACount, ACallback); + if FProxyTlsReady then + _ProxyTlsSend(ABuffer, ACount, ACallback) + else + inherited DirectSend(ABuffer, ACount, ACallback); end; procedure TCrossOpenSslConnection._Send(const ABytes: TBytes; @@ -935,10 +1182,7 @@ constructor TCrossOpenSslSocket.Create(const AIoThreads: Integer; const ASsl: Bo inherited Create(AIoThreads, ASsl); if Ssl then - begin - TSSLTools.LoadSSL; - _InitSslCtx; - end; + EnsureSslCtx; end; destructor TCrossOpenSslSocket.Destroy; @@ -947,13 +1191,23 @@ destructor TCrossOpenSslSocket.Destroy; // 不依赖 CTX 存活 (OpenSSL 保证), 所以 CTX 可以延后释放. inherited Destroy; - if Ssl then + if FTlsRuntimeLoaded then begin _FreeSslCtx; TSSLTools.UnloadSSL; end; end; +procedure TCrossOpenSslSocket.EnsureSslCtx; +begin + if not FTlsRuntimeLoaded then + begin + TSSLTools.LoadSSL; + FTlsRuntimeLoaded := True; + end; + _InitSslCtx; +end; + function TCrossOpenSslSocket.CreateConnection(const AOwner: TCrossSocketBase; const AClientSocket: TSocket; const AConnectType: TConnectType; const AHost: string; const AConnectCb: TCrossConnectionCallback): ICrossConnection; @@ -1170,9 +1424,31 @@ procedure TCrossOpenSslSocket.TriggerConnected(const AConnection: ICrossConnecti LRetCode: Integer; LHandshakeData: TBytes; LFatal: Boolean; + LProxyData: TBytes; begin LConnection := AConnection as TCrossOpenSslConnection; + if LConnection.ProxyUsesTlsTransport and not LConnection.ProxyTlsStarted then + begin + if LConnection._StartProxyTls(LProxyData) then + LConnection._RawSend(LProxyData, + procedure(const AConnection: ICrossConnection; const ASuccess: Boolean) + begin + if not ASuccess then + LConnection.Close; + end) + else + LConnection.Close; + Exit; + end; + + if LConnection.ProxyNeedsHandshake then + begin + if LConnection.ProxyStart(LProxyData) then + LConnection.SendProxyBytes(LProxyData); + Exit; + end; + if Ssl then begin LHandshakeData := nil; @@ -1217,18 +1493,43 @@ procedure TCrossOpenSslSocket.TriggerConnected(const AConnection: ICrossConnecti _Connected(LConnection); end; -procedure TCrossOpenSslSocket.TriggerReceived(const AConnection: ICrossConnection; - const ABuf: Pointer; const ALen: Integer); +procedure TCrossOpenSslSocket._ProcessReceivedPayload( + const AConnection: ICrossConnection; const APayload: Pointer; + const APayloadLen: Integer); var LConnectionObj: TCrossOpenSslConnection; LRetCode: Integer; LTriggerConnected: Boolean; LDecryptedData, LHandshakeData: TBytes; LFatal: Boolean; + LProxyData, LRemain: TBytes; + LProxyResult: TCrossProxyFeedResult; begin + LConnectionObj := AConnection as TCrossOpenSslConnection; + if (APayload = nil) or (APayloadLen <= 0) then + Exit; + + if LConnectionObj.ProxyNeedsHandshake then + begin + LProxyResult := LConnectionObj.ProxyFeed(APayload, APayloadLen, + LProxyData, LRemain); + case LProxyResult of + cpfrSendData: + LConnectionObj.SendProxyBytes(LProxyData); + cpfrComplete: + begin + TriggerConnected(AConnection); + if Length(LRemain) > 0 then + _ProcessReceivedPayload(AConnection, @LRemain[0], Length(LRemain)); + end; + cpfrFailed: + LConnectionObj.Close; + end; + Exit; + end; + if Ssl then begin - LConnectionObj := AConnection as TCrossOpenSslConnection; LTriggerConnected := False; LDecryptedData := nil; LHandshakeData := nil; @@ -1236,53 +1537,35 @@ procedure TCrossOpenSslSocket.TriggerReceived(const AConnection: ICrossConnectio LConnectionObj._SslLock; try - // 握手阶段输入字节限制: - // 仅在握手未完成时累加, 超阈值即视作 DoS 直接 fatal close. - // 握手成功后切换到正常数据流, 不再受此限制. if (LConnectionObj.ConnectStatus = csHandshaking) then begin - Inc(LConnectionObj.FHandshakeRecvBytes, ALen); + Inc(LConnectionObj.FHandshakeRecvBytes, APayloadLen); if (LConnectionObj.FHandshakeRecvBytes > MAX_HANDSHAKE_RECV_BYTES) then LFatal := True; end; if not LFatal then begin - // 将收到的加密数据写入内存 BIO, 让 OpenSSL 对其解密 - // 最初收到的数据是握手数据 - // 需要判断握手状态, 然后决定如何使用收到的数据 - LRetCode := LConnectionObj._BIO_write(ABuf, ALen); - if (LRetCode <> ALen) then + LRetCode := LConnectionObj._BIO_write(APayload, APayloadLen); + if (LRetCode <> APayloadLen) then begin - // BIO_write 失败 fatal: 标记后到锁外 Close (避免锁内 Close 重入风险) if LConnectionObj._SSL_handle_error(LRetCode, 'BIO_write') then LFatal := True; end else - // 握手完成 if (LConnectionObj._SSL_is_init_finished <> 0) then begin if (LConnectionObj.ConnectStatus = csHandshaking) then LTriggerConnected := True; - - // 读取解密后的数据 LDecryptedData := LConnectionObj._SSL_read_all; end else if (LConnectionObj.ConnectStatus = csHandshaking) then begin - // 继续握手 LRetCode := LConnectionObj._SSL_do_handshake; - - if (LRetCode <> 1) then - // 握手 fatal: 标记后到锁外 Close, 避免连接停滞 csHandshaking - if LConnectionObj._SSL_handle_error(LRetCode, - 'SSL_do_handshake(TriggerReceived)') then - LFatal := True; - - // 即使 fatal 也读出 BIO, 含可能的 TLS alert 发给对端 (RFC 5246 §7.2) + if (LRetCode <> 1) and + LConnectionObj._SSL_handle_error(LRetCode, + 'SSL_do_handshake(TriggerReceived)') then + LFatal := True; LHandshakeData := LConnectionObj._BIO_read_all; - - // 如果握手完成 - // 读取解密后的数据 if (LRetCode = 1) then begin LTriggerConnected := True; @@ -1294,22 +1577,69 @@ procedure TCrossOpenSslSocket.TriggerReceived(const AConnection: ICrossConnectio LConnectionObj._SslUnlock; end; - // 有握手数据 if (LHandshakeData <> nil) then - begin - // 先把握手数据发出去再触发连接事件和数据接收事件; - // fatal 时 alert 数据也通过这里发送, 发送完成后再 Close (优雅关闭) LConnectionObj._Send(LHandshakeData, - procedure(const AConnection: ICrossConnection; const ASuccess: Boolean) + procedure(const AInnerConnection: ICrossConnection; + const ASuccess: Boolean) begin - _FinishHandshakeProgress(ASuccess, LConnectionObj, LTriggerConnected, - LDecryptedData, LFatal); - end); - end else - _FinishHandshakeProgress(True, LConnectionObj, LTriggerConnected, - LDecryptedData, LFatal); + _FinishHandshakeProgress(ASuccess, LConnectionObj, + LTriggerConnected, LDecryptedData, LFatal); + end) + else + _FinishHandshakeProgress(True, LConnectionObj, + LTriggerConnected, LDecryptedData, LFatal); + end else + _Received(AConnection, APayload, APayloadLen); +end; + +procedure TCrossOpenSslSocket._FinishProxyTlsReceive( + const AConnection: ICrossConnection; const ASuccess: Boolean; + const APlainData: TBytes; const AHandshakeCompleted: Boolean); +var + LConnectionObj: TCrossOpenSslConnection; +begin + LConnectionObj := AConnection as TCrossOpenSslConnection; + if not ASuccess then + begin + LConnectionObj.Close; + Exit; + end; + if AHandshakeCompleted then + TriggerConnected(AConnection); + if Length(APlainData) > 0 then + _ProcessReceivedPayload(AConnection, @APlainData[0], Length(APlainData)); +end; + +procedure TCrossOpenSslSocket.TriggerReceived(const AConnection: ICrossConnection; + const ABuf: Pointer; const ALen: Integer); +var + LConnectionObj: TCrossOpenSslConnection; + LPlainData, LHandshakeData: TBytes; + LHandshakeCompleted: Boolean; +begin + LConnectionObj := AConnection as TCrossOpenSslConnection; + if LConnectionObj.ProxyUsesTlsTransport then + begin + if not LConnectionObj._FeedProxyTls(ABuf, ALen, LPlainData, + LHandshakeData, LHandshakeCompleted) then + begin + LConnectionObj.Close; + Exit; + end; + + if Length(LHandshakeData) > 0 then + LConnectionObj._RawSend(LHandshakeData, + procedure(const AInnerConnection: ICrossConnection; + const ASuccess: Boolean) + begin + _FinishProxyTlsReceive(AInnerConnection, ASuccess, LPlainData, + LHandshakeCompleted); + end) + else + _FinishProxyTlsReceive(AConnection, True, LPlainData, + LHandshakeCompleted); end else - _Received(AConnection, ABuf, ALen); + _ProcessReceivedPayload(AConnection, ABuf, ALen); end; end. diff --git a/Net/Net.CrossWebSocketClient.pas b/Net/Net.CrossWebSocketClient.pas index 67d1fc7..520ab81 100644 --- a/Net/Net.CrossWebSocketClient.pas +++ b/Net/Net.CrossWebSocketClient.pas @@ -20,6 +20,7 @@ interface Math, Net.SocketAPI, + Net.CrossProxy, Net.CrossSocket.Base, Net.CrossHttpClient, Net.CrossHttpUtils, @@ -456,6 +457,7 @@ TCrossWebSocketMgr = class(TCrossHttpClient, ICrossWebSocketMgr) class function GetDefault: ICrossWebSocketMgr; static; protected function CreateHttpCli(const AProtocol: string): ICrossHttpClientSocket; override; + procedure SetProxySettings(const AValue: TCrossProxySettings); override; public constructor Create(const AIoThreads: Integer = 2); reintroduce; destructor Destroy; override; @@ -1335,6 +1337,16 @@ function TCrossWebSocketMgr.CreateHttpCli( Result := inherited CreateHttpCli(AProtocol); end; +procedure TCrossWebSocketMgr.SetProxySettings( + const AValue: TCrossProxySettings); +var + LWsCli: ICrossHttpClientSocket; +begin + inherited SetProxySettings(AValue); + for LWsCli in FWsCliArr do + (LWsCli as TObject as TCrossHttpClientSocket).SyncProxySettings(AValue); +end; + function TCrossWebSocketMgr.CreateWebSocket( const AUrl: string): ICrossWebSocket; var From 8993bbe1434b0b5f763bf8953bb472e9ba34e5ae Mon Sep 17 00:00:00 2001 From: wqmeng Date: Sun, 6 Sep 2026 18:56:49 +0800 Subject: [PATCH 2/4] feat(proxy): add GUI UDP DNS diagnostics MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 中文：为标准 FMX 代理演示增加 UDP DNS 测试，支持 direct 和 SOCKS5 UDP ASSOCIATE，分别查询 A/AAAA 记录并显示实际 DNS 地址；明确拒绝 HTTP、HTTPS 和 SOCKS4 的 UDP 测试。修复合并后的 OpenSSL 错误清理和发送重载编译问题。 English: Add UDP DNS diagnostics to the standard FMX proxy demo with direct and SOCKS5 UDP ASSOCIATE support, A/AAAA result parsing, and explicit unsupported handling for HTTP, HTTPS, and SOCKS4. Fix the post-merge OpenSSL error cleanup and send-overload compilation issues. --- .../ProxyClientGui/ProxyClientGui.Main.fmx | 20 +- .../ProxyClientGui/ProxyClientGui.Main.pas | 29 ++- .../Delphi/ProxyClientGui/ProxyClientGui.dpr | 3 +- .../ProxyClientGui/ProxyClientGui.dproj | 1 + Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas | 4 + Net/Demos/Delphi/ProxyClientGui/ProxyUdp.pas | 219 ++++++++++++++++++ Net/Net.CrossSslSocket.OpenSSL.pas | 4 +- 7 files changed, 269 insertions(+), 11 deletions(-) create mode 100644 Net/Demos/Delphi/ProxyClientGui/ProxyUdp.pas diff --git a/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.fmx b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.fmx index 8442797..f3aff3b 100644 --- a/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.fmx +++ b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.fmx @@ -69,7 +69,7 @@ object ProxyMainForm: TProxyMainForm Size.Width = 100.000000000000000000 Size.Height = 32.000000000000000000 Size.PlatformDefault = False - TabOrder = 14 + TabOrder = 20 Text = 'Use Auth' OnChange = AuthClick end @@ -104,17 +104,27 @@ object ProxyMainForm: TProxyMainForm OnClick = DohProxyClick end object ResolveButton: TButton - Position.X = 406.000000000000000000 + Position.X = 536.000000000000000000 Position.Y = 64.000000000000000000 Size.Width = 120.000000000000000000 Size.Height = 36.000000000000000000 Size.PlatformDefault = False - TabOrder = 8 + TabOrder = 14 Text = 'IPv4/IPv6' OnClick = ResolveClick end + object UdpDnsButton: TButton + Position.X = 406.000000000000000000 + Position.Y = 64.000000000000000000 + Size.Width = 120.000000000000000000 + Size.Height = 36.000000000000000000 + Size.PlatformDefault = False + TabOrder = 8 + Text = 'UDP DNS' + OnClick = UdpDnsClick + end object WsDirectButton: TButton - Position.X = 556.000000000000000000 + Position.X = 666.000000000000000000 Position.Y = 64.000000000000000000 Size.Width = 120.000000000000000000 Size.Height = 36.000000000000000000 @@ -124,7 +134,7 @@ object ProxyMainForm: TProxyMainForm OnClick = WsDirectClick end object WsProxyButton: TButton - Position.X = 686.000000000000000000 + Position.X = 796.000000000000000000 Position.Y = 64.000000000000000000 Size.Width = 120.000000000000000000 Size.Height = 36.000000000000000000 diff --git a/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.pas b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.pas index d9e95c9..f07ebf6 100644 --- a/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.pas +++ b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.Main.pas @@ -1,4 +1,4 @@ -unit ProxyClientGui.Main; +unit ProxyClientGui.Main; interface @@ -25,6 +25,7 @@ interface Net.CrossWebSocketParser, Utils.Utils, ProxyDns, + ProxyUdp, FMX.Memo.Types, FMX.ScrollBox, FMX.Controls.Presentation; @@ -40,6 +41,7 @@ TProxyMainForm = class(TForm) GoogleButton: TButton; DnsDirectButton: TButton; DnsProxyButton: TButton; + UdpDnsButton: TButton; ResolveButton: TButton; WsDirectButton: TButton; WsProxyButton: TButton; @@ -49,6 +51,7 @@ TProxyMainForm = class(TForm) procedure HttpClick(Sender: TObject); procedure DohDirectClick(Sender: TObject); procedure DohProxyClick(Sender: TObject); + procedure UdpDnsClick(Sender: TObject); procedure ResolveClick(Sender: TObject); procedure WsDirectClick(Sender: TObject); procedure WsProxyClick(Sender: TObject); @@ -158,10 +161,10 @@ procedure TProxyMainForm.ResolveDns(const AProxy: Boolean); LServer, LIP, LIPv6: string; begin LSettings := TCrossProxySettings.Direct; - LServer := '223.5.5.5'; + LServer := DNS_DIRECT_SERVER; if AProxy then begin LSettings := Settings; - LServer := '8.8.8.8'; + LServer := DNS_PROXY_SERVER; end; Log('DNS apple.com ' + ProxyLabel(AProxy) + ' server ' + LServer + ':53'); try @@ -229,6 +232,26 @@ procedure TProxyMainForm.DohProxyClick(Sender: TObject); begin ResolveDns(True); end; +procedure TProxyMainForm.UdpDnsClick(Sender: TObject); +var + LSettings: TCrossProxySettings; +begin + if SameText(ProxyType.Text, 'direct') then + LSettings := TCrossProxySettings.Direct + else + LSettings := Settings; + if SameText(ProxyType.Text, 'direct') then + Log('UDP DNS direct server ' + UDP_DIRECT_DNS_SERVER + ':53') + else + Log('UDP DNS ' + ProxyLabel(True) + ' proxy ' + ProxyHost.Text + ':' + ProxyPort.Text + ' target ' + UDP_PROXY_DNS_SERVER + ':53'); + TThread.CreateAnonymousThread( + procedure + var LResult: string; + begin + try LResult := TestUdpDns(LSettings, UseAuth.IsChecked); except on E: Exception do LResult := 'UDP DNS FAILED: ' + E.Message; end; + Log(LResult); + end).Start; +end; procedure TProxyMainForm.ResolveClick(Sender: TObject); begin ToggleProxyAddress; diff --git a/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dpr b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dpr index 9726567..38dfecf 100644 --- a/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dpr +++ b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dpr @@ -3,7 +3,8 @@ uses System.StartUpCopy, FMX.Forms, ProxyClientGui.Main in 'ProxyClientGui.Main.pas' {ProxyMainForm}, - ProxyDns in 'ProxyDns.pas'; + ProxyDns in 'ProxyDns.pas', + ProxyUdp in 'ProxyUdp.pas'; {$R *.res} begin diff --git a/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dproj b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dproj index 39052d4..2cb3dd7 100644 --- a/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dproj +++ b/Net/Demos/Delphi/ProxyClientGui/ProxyClientGui.dproj @@ -56,6 +56,7 @@ fmx + Base diff --git a/Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas b/Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas index c92e674..b190979 100644 --- a/Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas +++ b/Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas @@ -8,6 +8,10 @@ interface Net.Winsock2, Net.CrossProxy; +const + DNS_DIRECT_SERVER = '223.5.5.5'; + DNS_PROXY_SERVER = '8.8.8.8'; + function QueryDnsA(const AServer: string; const AProxy: TCrossProxySettings): string; function QueryDnsAAAA(const AServer: string; const AProxy: TCrossProxySettings): string; diff --git a/Net/Demos/Delphi/ProxyClientGui/ProxyUdp.pas b/Net/Demos/Delphi/ProxyClientGui/ProxyUdp.pas new file mode 100644 index 0000000..33939fe --- /dev/null +++ b/Net/Demos/Delphi/ProxyClientGui/ProxyUdp.pas @@ -0,0 +1,219 @@ +unit ProxyUdp; + +interface + +uses + System.SysUtils, + Net.SocketAPI, + Net.Winsock2, + Net.CrossProxy; + +const + UDP_DIRECT_DNS_SERVER = '223.5.5.5'; + UDP_PROXY_DNS_SERVER = '1.1.1.1'; + +function TestUdpDns(const ASettings: TCrossProxySettings; + const AUseAuth: Boolean): string; + +implementation + +function BuildDnsQuery(const AType: Word): TBytes; +begin + Result := [$CA, $FE, $01, $00, $00, $01, $00, $00, $00, $00, $00, $00, + $05, $61, $70, $70, $6C, $65, $03, $63, $6F, $6D, $00, + Byte(AType shr 8), Byte(AType), $00, $01]; +end; + +function ParseDnsAddress(const ABuffer; const ALength, AType: Integer): string; +var + B: PByte; O, I, Count, RType, RLength: Integer; +begin + Result := ''; + if ALength < 12 then Exit; + B := @ABuffer; + O := 12; + while (O < ALength) and (B[O] <> 0) do Inc(O, B[O] + 1); + Inc(O, 5); + Count := (B[6] shl 8) or B[7]; + for I := 1 to Count do + begin + if O >= ALength then Exit; + if (B[O] and $C0) = $C0 then Inc(O, 2) + else begin while (O < ALength) and (B[O] <> 0) do Inc(O, B[O] + 1); Inc(O); end; + if O + 10 >= ALength then Exit; + RType := (B[O] shl 8) or B[O + 1]; + RLength := (B[O + 8] shl 8) or B[O + 9]; + Inc(O, 10); + if O + RLength > ALength then Exit; + if (RType = AType) and (AType = 1) and (RLength = 4) then + Exit(Format('%d.%d.%d.%d', [B[O], B[O + 1], B[O + 2], B[O + 3]])); + if (RType = AType) and (AType = 28) and (RLength = 16) then + Exit(Format('%x:%x:%x:%x:%x:%x:%x:%x', [ + (B[O] shl 8) or B[O+1], (B[O+2] shl 8) or B[O+3], + (B[O+4] shl 8) or B[O+5], (B[O+6] shl 8) or B[O+7], + (B[O+8] shl 8) or B[O+9], (B[O+10] shl 8) or B[O+11], + (B[O+12] shl 8) or B[O+13], (B[O+14] shl 8) or B[O+15]])); + Inc(O, RLength); + end; +end; + +function ReadBytes(const ASocket: TSocket; var ABuffer; const ACount: Integer): Boolean; +var + LOffset, LRead: Integer; +begin + LOffset := 0; + while LOffset < ACount do + begin + LRead := TSocketAPI.Recv(ASocket, PByte(@ABuffer)[LOffset], ACount - LOffset); + if LRead <= 0 then Exit(False); + Inc(LOffset, LRead); + end; + Result := True; +end; + +procedure WriteBytes(const ASocket: TSocket; const ABuffer; const ACount: Integer); +begin + if TSocketAPI.Send(ASocket, ABuffer, ACount) <> ACount then + raise Exception.Create('Short write during SOCKS5 UDP handshake'); +end; + +function TestDirectUdp(const AType: Word): string; +var + LH: TRawAddrInfo; + LI: PRawAddrInfo; + LS: TSocket; + LBuf: array[0..2047] of Byte; + LQuery: TBytes; + LSent, LReceived: Integer; +begin + FillChar(LH, SizeOf(LH), 0); + LH.ai_family := AF_INET; + LH.ai_socktype := SOCK_DGRAM; + LH.ai_protocol := IPPROTO_UDP; + LI := TSocketAPI.GetAddrInfo(UDP_DIRECT_DNS_SERVER, 53, LH); + if LI = nil then raise Exception.Create('Unable to resolve UDP DNS server'); + try + LS := TSocketAPI.NewSocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP); + if not TSocketAPI.IsValidSocket(LS) then raise Exception.Create('Unable to create UDP socket'); + try + TSocketAPI.SetRecvTimeout(LS, 5000); + if TSocketAPI.Connect(LS, LI.ai_addr, LI.ai_addrlen) <> 0 then + raise Exception.Create('Unable to connect UDP DNS server'); + LQuery := BuildDnsQuery(AType); + LSent := TSocketAPI.Send(LS, LQuery[0], Length(LQuery)); + LReceived := TSocketAPI.Recv(LS, LBuf[0], Length(LBuf)); + if (LSent = Length(LQuery)) and (LReceived >= 12) and + (LBuf[0] = $CA) and (LBuf[1] = $FE) then + Result := ParseDnsAddress(LBuf, LReceived, AType) + else + Result := Format('UDP DNS failed, sent=%d received=%d', [LSent, LReceived]); + finally + TSocketAPI.CloseSocket(LS); + end; + finally + TSocketAPI.FreeAddrInfo(LI); + end; +end; + +function TestSocks5Udp(const ASettings: TCrossProxySettings; + const AUseAuth: Boolean; const AType: Word): string; +var + LH: TRawAddrInfo; + LI: PRawAddrInfo; + LTcp, LUdp: TSocket; + LMethod, LAssociate: array[0..9] of Byte; + LAuth, LPacket, LQuery: TBytes; + LResponse: array[0..2047] of Byte; + LRelay: sockaddr_in; + LFrom: sockaddr; + LDnsHints: TRawAddrInfo; + LDnsInfo: PRawAddrInfo; + LFromLen, LSent, LReceived, I: Integer; +begin + FillChar(LH, SizeOf(LH), 0); + LH.ai_family := AF_INET; LH.ai_socktype := SOCK_STREAM; LH.ai_protocol := IPPROTO_TCP; + LI := TSocketAPI.GetAddrInfo(ASettings.Host, ASettings.Port, LH); + if LI = nil then raise Exception.Create('Unable to resolve SOCKS5 proxy'); + try + LTcp := TSocketAPI.NewSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP); + if TSocketAPI.Connect(LTcp, LI.ai_addr, LI.ai_addrlen) <> 0 then + raise Exception.Create('Unable to connect SOCKS5 proxy'); + try + TSocketAPI.SetRecvTimeout(LTcp, 5000); + // Use Auth 关闭时只声明无认证，避免客户端意外尝试用户名密码认证。 + LMethod[0] := 5; LMethod[1] := 1; LMethod[2] := Ord(AUseAuth) * 2; + WriteBytes(LTcp, LMethod[0], 3); + if not ReadBytes(LTcp, LMethod[0], 2) or (LMethod[0] <> 5) then + raise Exception.Create('Invalid SOCKS5 method response'); + if LMethod[1] = 2 then + begin + if not AUseAuth then + raise Exception.Create('SOCKS5 proxy selected authentication unexpectedly'); + SetLength(LAuth, 3 + Length(ASettings.Username) + Length(ASettings.Password)); + LAuth[0] := 1; LAuth[1] := Length(ASettings.Username); + if Length(ASettings.Username) > 0 then Move(ASettings.Username[1], LAuth[2], Length(ASettings.Username)); + LAuth[2 + Length(ASettings.Username)] := Length(ASettings.Password); + if Length(ASettings.Password) > 0 then Move(ASettings.Password[1], LAuth[3 + Length(ASettings.Username)], Length(ASettings.Password)); + WriteBytes(LTcp, LAuth[0], Length(LAuth)); + if not ReadBytes(LTcp, LMethod[0], 2) or (LMethod[1] <> 0) then + raise Exception.Create('SOCKS5 username/password authentication failed'); + end else if LMethod[1] <> 0 then + raise Exception.Create('SOCKS5 proxy rejected the requested authentication method'); + FillChar(LAssociate, SizeOf(LAssociate), 0); + LAssociate[0] := 5; LAssociate[1] := 3; LAssociate[3] := 1; + WriteBytes(LTcp, LAssociate[0], 10); + if not ReadBytes(LTcp, LAssociate[0], 4) or (LAssociate[1] <> 0) or (LAssociate[3] <> 1) then + raise Exception.Create('SOCKS5 UDP ASSOCIATE failed'); + if not ReadBytes(LTcp, LAssociate[4], 6) then raise Exception.Create('Incomplete UDP relay address'); + FillChar(LRelay, SizeOf(LRelay), 0); LRelay.sin_family := AF_INET; + Move(LAssociate[4], LRelay.sin_addr, 4); Move(LAssociate[8], LRelay.sin_port, 2); + if LRelay.sin_addr.S_addr = 0 then LRelay.sin_addr.S_addr := PSockAddrIn(LI.ai_addr)^.sin_addr.S_addr; + LUdp := TSocketAPI.NewSocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP); + try + FillChar(LDnsHints, SizeOf(LDnsHints), 0); + LDnsHints.ai_family := AF_INET; + LDnsHints.ai_socktype := SOCK_DGRAM; + LDnsHints.ai_protocol := IPPROTO_UDP; + LDnsInfo := TSocketAPI.GetAddrInfo(UDP_PROXY_DNS_SERVER, 53, LDnsHints); + if LDnsInfo = nil then + raise Exception.Create('Unable to resolve proxy UDP DNS server'); + try + LQuery := BuildDnsQuery(AType); + SetLength(LPacket, 10 + Length(LQuery)); FillChar(LPacket[0], Length(LPacket), 0); + // 代理 UDP 测试使用独立的 DNS 服务器，和 direct 模式区分开。 + LPacket[3] := 1; + // UDP_PROXY_DNS_SERVER is used as the actual SOCKS5 UDP target. + Move(PSockAddrIn(LDnsInfo.ai_addr)^.sin_addr, LPacket[4], 4); + LPacket[8] := 0; LPacket[9] := 53; + for I := 0 to High(LQuery) do LPacket[10 + I] := LQuery[I]; + LSent := TSocketAPI.SendTo(LUdp, @LRelay, SizeOf(LRelay), LPacket[0], Length(LPacket)); + LFromLen := SizeOf(LFrom); LReceived := TSocketAPI.RecvFrom(LUdp, @LFrom, LFromLen, LResponse[0], Length(LResponse)); + if (LSent = Length(LPacket)) and (LReceived > 12) and (LResponse[3] = 1) and + (LResponse[10] = $CA) and (LResponse[11] = $FE) then + Result := ParseDnsAddress(LResponse[10], LReceived - 10, AType) + else Result := Format('SOCKS5 UDP DNS failed, sent=%d received=%d', [LSent, LReceived]); + finally TSocketAPI.FreeAddrInfo(LDnsInfo); end; + finally TSocketAPI.CloseSocket(LUdp); end; + finally TSocketAPI.CloseSocket(LTcp); end; + finally TSocketAPI.FreeAddrInfo(LI); end; +end; + +function TestUdpDns(const ASettings: TCrossProxySettings; + const AUseAuth: Boolean): string; +begin + if ASettings.ProxyType <> cptSocks5 then + if ASettings.IsEnabled then + Exit('UDP proxy test is supported only for socks5 (UDP ASSOCIATE)'); + if ASettings.IsEnabled then + begin + Result := 'UDP DNS A apple.com -> ' + TestSocks5Udp(ASettings, AUseAuth, 1) + sLineBreak; + Result := Result + 'UDP DNS AAAA apple.com -> ' + TestSocks5Udp(ASettings, AUseAuth, 28); + end + else + begin + Result := 'UDP DNS A apple.com -> ' + TestDirectUdp(1) + sLineBreak; + Result := Result + 'UDP DNS AAAA apple.com -> ' + TestDirectUdp(28); + end; +end; + +end. diff --git a/Net/Net.CrossSslSocket.OpenSSL.pas b/Net/Net.CrossSslSocket.OpenSSL.pas index 24d9f9b..18aba56 100644 --- a/Net/Net.CrossSslSocket.OpenSSL.pas +++ b/Net/Net.CrossSslSocket.OpenSSL.pas @@ -751,7 +751,7 @@ function TCrossOpenSslConnection._StartProxyTls( if LHostAnsi = '' then raise ECrossSocket.Create( 'A HTTPS proxy host name is required when peer verification is enabled.'); - ClearOpenSslErrors; + ERR_clear_error(); if SSL_set1_host(FProxySslData, PAnsiChar(LHostAnsi)) <= 0 then raise ECrossSocket.CreateFmt('SSL_set1_host for HTTPS proxy failed: %s.', [GetOpenSslErrors]); @@ -915,7 +915,7 @@ procedure TCrossOpenSslConnection._Send(const ABytes: TBytes; end; LBytes := ABytes; - _Send(@LBytes[0], Length(LBytes), + _Send(Pointer(@LBytes[0]), Length(LBytes), procedure(const AConnection: ICrossConnection; const ASuccess: Boolean) begin LBytes := nil; From e8f7ebc789d082dbfa82d262abbfdec958344d8e Mon Sep 17 00:00:00 2001 From: wqmeng Date: Sun, 6 Sep 2026 19:45:52 +0800 Subject: [PATCH 3/4] fix(proxy): support authenticated IPv6 UDP DNS MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 中文：修复 DNS 和 UDP DNS 的 SOCKS5 用户名密码 ASCII 编码问题；修复 IPv4/IPv6 UDP Relay 地址处理及 IPv6 接收地址缓冲区，确保代理认证和 A/AAAA 查询结果正常返回。 English: Fix ASCII encoding of SOCKS5 credentials for DNS and UDP DNS, and correct IPv4/IPv6 UDP relay handling and IPv6 receive-address storage so proxy authentication and A/AAAA results work correctly. --- Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas | 18 +++--- Net/Demos/Delphi/ProxyClientGui/ProxyUdp.pas | 61 +++++++++++++------- 2 files changed, 51 insertions(+), 28 deletions(-) diff --git a/Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas b/Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas index b190979..2d7a357 100644 --- a/Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas +++ b/Net/Demos/Delphi/ProxyClientGui/ProxyDns.pas @@ -53,7 +53,7 @@ function QueryDnsType(const AServer: string; const AProxy: TCrossProxySettings; P, A: TBytes; R: array[0..2047] of Byte; G: array[0..3] of Byte; - Auth: TBytes; + Auth, UserBytes, PasswordBytes: TBytes; LenBuf: array[0..1] of Byte; N, L, O, C: Integer; B: array[0..3] of Byte; @@ -117,14 +117,16 @@ function QueryDnsType(const AServer: string; const AProxy: TCrossProxySettings; raise Exception.Create('SOCKS5 proxy did not select username/password authentication'); if (Length(AProxy.Username) > 255) or (Length(AProxy.Password) > 255) then raise Exception.Create('SOCKS5 credentials exceed 255 bytes'); - SetLength(Auth, 3 + Length(AProxy.Username) + Length(AProxy.Password)); + UserBytes := TEncoding.ASCII.GetBytes(AProxy.Username); + PasswordBytes := TEncoding.ASCII.GetBytes(AProxy.Password); + SetLength(Auth, 3 + Length(UserBytes) + Length(PasswordBytes)); Auth[0] := $01; - Auth[1] := Length(AProxy.Username); - if Length(AProxy.Username) > 0 then - Move(AProxy.Username[1], Auth[2], Length(AProxy.Username)); - Auth[2 + Length(AProxy.Username)] := Length(AProxy.Password); - if Length(AProxy.Password) > 0 then - Move(AProxy.Password[1], Auth[3 + Length(AProxy.Username)], Length(AProxy.Password)); + Auth[1] := Length(UserBytes); + if Length(UserBytes) > 0 then + Move(UserBytes[0], Auth[2], Length(UserBytes)); + Auth[2 + Length(UserBytes)] := Length(PasswordBytes); + if Length(PasswordBytes) > 0 then + Move(PasswordBytes[0], Auth[3 + Length(UserBytes)], Length(PasswordBytes)); SendAll(S, Auth[0], Length(Auth)); ReadAll(S, G, 2); if (G[0] <> $01) or (G[1] <> $00) then diff --git a/Net/Demos/Delphi/ProxyClientGui/ProxyUdp.pas b/Net/Demos/Delphi/ProxyClientGui/ProxyUdp.pas index 33939fe..b528cc4 100644 --- a/Net/Demos/Delphi/ProxyClientGui/ProxyUdp.pas +++ b/Net/Demos/Delphi/ProxyClientGui/ProxyUdp.pas @@ -121,21 +121,21 @@ function TestSocks5Udp(const ASettings: TCrossProxySettings; LH: TRawAddrInfo; LI: PRawAddrInfo; LTcp, LUdp: TSocket; - LMethod, LAssociate: array[0..9] of Byte; - LAuth, LPacket, LQuery: TBytes; + LMethod, LAssociate: array[0..21] of Byte; + LAuth, LPacket, LQuery, LUserBytes, LPasswordBytes: TBytes; LResponse: array[0..2047] of Byte; - LRelay: sockaddr_in; - LFrom: sockaddr; + LRelay: TRawSockAddrIn; + LFrom: TRawSockAddrIn; LDnsHints: TRawAddrInfo; LDnsInfo: PRawAddrInfo; - LFromLen, LSent, LReceived, I: Integer; + LRelayLen, LFromLen, LSent, LReceived, I: Integer; begin FillChar(LH, SizeOf(LH), 0); - LH.ai_family := AF_INET; LH.ai_socktype := SOCK_STREAM; LH.ai_protocol := IPPROTO_TCP; + LH.ai_family := AF_UNSPEC; LH.ai_socktype := SOCK_STREAM; LH.ai_protocol := IPPROTO_TCP; LI := TSocketAPI.GetAddrInfo(ASettings.Host, ASettings.Port, LH); if LI = nil then raise Exception.Create('Unable to resolve SOCKS5 proxy'); try - LTcp := TSocketAPI.NewSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP); + LTcp := TSocketAPI.NewSocket(LI.ai_family, SOCK_STREAM, IPPROTO_TCP); if TSocketAPI.Connect(LTcp, LI.ai_addr, LI.ai_addrlen) <> 0 then raise Exception.Create('Unable to connect SOCKS5 proxy'); try @@ -149,11 +149,13 @@ function TestSocks5Udp(const ASettings: TCrossProxySettings; begin if not AUseAuth then raise Exception.Create('SOCKS5 proxy selected authentication unexpectedly'); - SetLength(LAuth, 3 + Length(ASettings.Username) + Length(ASettings.Password)); - LAuth[0] := 1; LAuth[1] := Length(ASettings.Username); - if Length(ASettings.Username) > 0 then Move(ASettings.Username[1], LAuth[2], Length(ASettings.Username)); - LAuth[2 + Length(ASettings.Username)] := Length(ASettings.Password); - if Length(ASettings.Password) > 0 then Move(ASettings.Password[1], LAuth[3 + Length(ASettings.Username)], Length(ASettings.Password)); + LUserBytes := TEncoding.ASCII.GetBytes(ASettings.Username); + LPasswordBytes := TEncoding.ASCII.GetBytes(ASettings.Password); + SetLength(LAuth, 3 + Length(LUserBytes) + Length(LPasswordBytes)); + LAuth[0] := 1; LAuth[1] := Length(LUserBytes); + if Length(LUserBytes) > 0 then Move(LUserBytes[0], LAuth[2], Length(LUserBytes)); + LAuth[2 + Length(LUserBytes)] := Length(LPasswordBytes); + if Length(LPasswordBytes) > 0 then Move(LPasswordBytes[0], LAuth[3 + Length(LUserBytes)], Length(LPasswordBytes)); WriteBytes(LTcp, LAuth[0], Length(LAuth)); if not ReadBytes(LTcp, LMethod[0], 2) or (LMethod[1] <> 0) then raise Exception.Create('SOCKS5 username/password authentication failed'); @@ -162,13 +164,26 @@ function TestSocks5Udp(const ASettings: TCrossProxySettings; FillChar(LAssociate, SizeOf(LAssociate), 0); LAssociate[0] := 5; LAssociate[1] := 3; LAssociate[3] := 1; WriteBytes(LTcp, LAssociate[0], 10); - if not ReadBytes(LTcp, LAssociate[0], 4) or (LAssociate[1] <> 0) or (LAssociate[3] <> 1) then + if not ReadBytes(LTcp, LAssociate[0], 4) or (LAssociate[1] <> 0) or + not (LAssociate[3] in [1, 4]) then raise Exception.Create('SOCKS5 UDP ASSOCIATE failed'); - if not ReadBytes(LTcp, LAssociate[4], 6) then raise Exception.Create('Incomplete UDP relay address'); - FillChar(LRelay, SizeOf(LRelay), 0); LRelay.sin_family := AF_INET; - Move(LAssociate[4], LRelay.sin_addr, 4); Move(LAssociate[8], LRelay.sin_port, 2); - if LRelay.sin_addr.S_addr = 0 then LRelay.sin_addr.S_addr := PSockAddrIn(LI.ai_addr)^.sin_addr.S_addr; - LUdp := TSocketAPI.NewSocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP); + if LAssociate[3] = 1 then + begin + if not ReadBytes(LTcp, LAssociate[4], 6) then raise Exception.Create('Incomplete IPv4 UDP relay address'); + FillChar(LRelay, SizeOf(LRelay), 0); LRelay.Addr.sin_family := AF_INET; + Move(LAssociate[4], LRelay.Addr.sin_addr, 4); Move(LAssociate[8], LRelay.Addr.sin_port, 2); + if LRelay.Addr.sin_addr.S_addr = 0 then LRelay.Addr.sin_addr.S_addr := PSockAddrIn(LI.ai_addr)^.sin_addr.S_addr; + LRelayLen := SizeOf(sockaddr_in); + end + else + begin + if not ReadBytes(LTcp, LAssociate[4], 18) then raise Exception.Create('Incomplete IPv6 UDP relay address'); + FillChar(LRelay, SizeOf(LRelay), 0); LRelay.Addr6.sin6_family := AF_INET6; + Move(LAssociate[4], LRelay.Addr6.sin6_addr, 16); Move(LAssociate[20], LRelay.Addr6.sin6_port, 2); + if IN6ADDR_ISANY(@LRelay.Addr6.sin6_addr) then LRelay.Addr6.sin6_addr := PSockAddrIn6(LI.ai_addr)^.sin6_addr; + LRelayLen := SizeOf(sockaddr_in6); + end; + LUdp := TSocketAPI.NewSocket(LRelay.Addr.sin_family, SOCK_DGRAM, IPPROTO_UDP); try FillChar(LDnsHints, SizeOf(LDnsHints), 0); LDnsHints.ai_family := AF_INET; @@ -186,8 +201,14 @@ function TestSocks5Udp(const ASettings: TCrossProxySettings; Move(PSockAddrIn(LDnsInfo.ai_addr)^.sin_addr, LPacket[4], 4); LPacket[8] := 0; LPacket[9] := 53; for I := 0 to High(LQuery) do LPacket[10 + I] := LQuery[I]; - LSent := TSocketAPI.SendTo(LUdp, @LRelay, SizeOf(LRelay), LPacket[0], Length(LPacket)); - LFromLen := SizeOf(LFrom); LReceived := TSocketAPI.RecvFrom(LUdp, @LFrom, LFromLen, LResponse[0], Length(LResponse)); + // TRawSockAddrIn 头部包含 AddrLen，SendTo 必须传入实际 sockaddr 联合体地址。 + if LRelay.Addr.sin_family = AF_INET then + LSent := TSocketAPI.SendTo(LUdp, @LRelay.Addr, LRelayLen, LPacket[0], Length(LPacket)) + else + LSent := TSocketAPI.SendTo(LUdp, @LRelay.Addr6, LRelayLen, LPacket[0], Length(LPacket)); + // IPv6 UDP relay 可能返回 sockaddr_in6，接收地址缓冲区不能使用 16 字节 sockaddr。 + LFromLen := SizeOf(sockaddr_in6); + LReceived := TSocketAPI.RecvFrom(LUdp, @LFrom.Addr, LFromLen, LResponse[0], Length(LResponse)); if (LSent = Length(LPacket)) and (LReceived > 12) and (LResponse[3] = 1) and (LResponse[10] = $CA) and (LResponse[11] = $FE) then Result := ParseDnsAddress(LResponse[10], LReceived - 10, AType) From 97e3e2fc9475fcd39df21b308ae2591048cbb9bd Mon Sep 17 00:00:00 2001 From: wqmeng Date: Sun, 6 Sep 2026 20:01:18 +0800 Subject: [PATCH 4/4] fix(proxy): normalize console project metadata MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 中文：补齐 ProxyClient 的标准 ProjectVersion 和 Release 配置，并使用 $(MainSource) 绑定 DelphiCompile，修复 RAD Studio 保存项目异常及重复入口文件导致的 F1026 编译错误。 English: Normalize ProxyClient project metadata with the standard ProjectVersion and Release configuration, and bind DelphiCompile through $(MainSource) to fix RAD Studio save failures and the F1026 duplicate entry-file error. --- Net/Demos/Delphi/ProxyClient/ProxyClient.dproj | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/Net/Demos/Delphi/ProxyClient/ProxyClient.dproj b/Net/Demos/Delphi/ProxyClient/ProxyClient.dproj index 5976805..15466bc 100644 --- a/Net/Demos/Delphi/ProxyClient/ProxyClient.dproj +++ b/Net/Demos/Delphi/ProxyClient/ProxyClient.dproj @@ -1,6 +1,7 @@ {D8C7E2E5-42C8-4D2D-9A77-7B0F9C6D1D24} + 20.4 ProxyClient.dpr true Debug @@ -15,6 +16,12 @@ bin\$(Platform)\ .\$(Platform)\$(Config) + + true + true + RELEASE;$(DCC_Define) + false + true true @@ -22,7 +29,9 @@ true - + + MainSource +