diff --git a/ProxyFormUnit.fmx b/ProxyFormUnit.fmx index 9807e7d..fa95d1b 100644 --- a/ProxyFormUnit.fmx +++ b/ProxyFormUnit.fmx @@ -3,7 +3,7 @@ object MainForm: TMainForm Top = 0 Caption = 'Ceton HDHomeRun Proxy' ClientHeight = 507 - ClientWidth = 472 + ClientWidth = 400 Fill.Kind = Solid Position = ScreenCenter StyleBook = StyleBook1 @@ -16,21 +16,21 @@ object MainForm: TMainForm DesignerMasterStyle = 0 object VertScrollBox1: TVertScrollBox Align = Client - Size.Width = 472.000000000000000000 + Size.Width = 400.000000000000000000 Size.Height = 507.000000000000000000 Size.PlatformDefault = False TabOrder = 3 - Viewport.Width = 472.000000000000000000 + Viewport.Width = 400.000000000000000000 Viewport.Height = 507.000000000000000000 object OuterPanelContainer: TLayout Align = Top - Size.Width = 472.000000000000000000 + Size.Width = 400.000000000000000000 Size.Height = 505.000000000000000000 Size.PlatformDefault = False TabOrder = 0 object PanelContainer: TLayout Align = Top - Size.Width = 472.000000000000000000 + Size.Width = 400.000000000000000000 Size.Height = 1000.000000000000000000 Size.PlatformDefault = False TabOrder = 0 @@ -44,7 +44,7 @@ object MainForm: TMainForm Position.X = 3.000000000000000000 Position.Y = 68.000000000000000000 ShowCheck = False - Size.Width = 466.000000000000000000 + Size.Width = 394.000000000000000000 Size.Height = 20.000000000000000000 Size.PlatformDefault = False Text = 'Advanced Settings' @@ -111,13 +111,14 @@ object MainForm: TMainForm Touch.InteractiveGestures = [LongTap, DoubleTap] TabOrder = 0 ItemHeight = 19.000000000000000000 + ItemWidth = 300.000000000000000000 ItemIndex = -1 Position.X = 210.000000000000000000 Position.Y = 9.000000000000000000 Hint = 'The local IP address that will be listened on for video data fro' + 'm the Ceton device. Leave blank to auto-detect.' - Size.Width = 220.000000000000000000 + Size.Width = 150.000000000000000000 Size.Height = 22.000000000000000000 Size.PlatformDefault = False OnChangeTracking = ceCetonListenIPChangeTracking @@ -128,13 +129,14 @@ object MainForm: TMainForm Touch.InteractiveGestures = [LongTap, DoubleTap] TabOrder = 1 ItemHeight = 19.000000000000000000 + ItemWidth = 300.000000000000000000 ItemIndex = -1 Position.X = 210.000000000000000000 Position.Y = 40.000000000000000000 Hint = 'The local IP address that will be listened on for all HDHomeRun ' + 'requests. Leave blank to auto-detect.' - Size.Width = 220.000000000000000000 + Size.Width = 150.000000000000000000 Size.Height = 22.000000000000000000 Size.PlatformDefault = False OnChangeTracking = ceHDHRListenIPChangeTracking @@ -165,7 +167,7 @@ object MainForm: TMainForm 'The address that will be given to DVR software to use for HDHome' + 'Run HTTP video and lineup requests. Leave blank to auto-detect ' + 'based on each request received.' - Size.Width = 220.000000000000000000 + Size.Width = 150.000000000000000000 Size.Height = 22.000000000000000000 Size.PlatformDefault = False OnChangeTracking = eHDHRExternalAddressChangeTracking @@ -180,6 +182,9 @@ object MainForm: TMainForm Hint = 'The port that will be given to DVR software to use for HDHomeRun' + ' HTTP video and lineup requests.' + Size.Width = 71.000000000000000000 + Size.Height = 22.000000000000000000 + Size.PlatformDefault = False OnChangeTracking = eHDHRExternalHTTPPortChangeTracking OnMouseEnter = EditMouseEnter OnMouseLeave = EditMouseLeave @@ -194,7 +199,7 @@ object MainForm: TMainForm Position.X = 3.000000000000000000 Position.Y = 3.000000000000000000 ShowCheck = False - Size.Width = 466.000000000000000000 + Size.Width = 394.000000000000000000 Size.Height = 59.000000000000000000 Size.PlatformDefault = False Text = 'Settings' @@ -202,22 +207,28 @@ object MainForm: TMainForm OnMouseDown = PanelMouseDown OnResized = PanelResizing ContentSize = '39' - object eCetonTunerAddress: TEdit + object Label1: TLabel + Position.X = 15.000000000000000000 + Position.Y = 12.000000000000000000 + Text = 'Ceton tuner address:' + TabOrder = 1 + end + object eCetonTunerAddress: TComboEdit Touch.InteractiveGestures = [LongTap, DoubleTap] TabOrder = 0 + ItemHeight = 19.000000000000000000 + ItemWidth = 300.000000000000000000 + ItemIndex = -1 Position.X = 210.000000000000000000 Position.Y = 9.000000000000000000 - Size.Width = 143.000000000000000000 + Hint = + 'The local IP address that will be listened on for video data fro' + + 'm the Ceton device. Leave blank to auto-detect.' + Size.Width = 150.000000000000000000 Size.Height = 22.000000000000000000 Size.PlatformDefault = False OnChangeTracking = eCetonTunerAddressChangeTracking end - object Label1: TLabel - Position.X = 15.000000000000000000 - Position.Y = 12.000000000000000000 - Text = 'Ceton tuner address:' - TabOrder = 1 - end end object pnlStatistics: TExpander Align = Top @@ -226,7 +237,7 @@ object MainForm: TMainForm Position.X = 3.000000000000000000 Position.Y = 120.000000000000000000 ShowCheck = False - Size.Width = 466.000000000000000000 + Size.Width = 394.000000000000000000 Size.Height = 354.000000000000000000 Size.PlatformDefault = False Text = 'Statistics' @@ -246,7 +257,7 @@ object MainForm: TMainForm Margins.Left = 10.000000000000000000 Margins.Top = 9.000000000000000000 Margins.Right = 10.000000000000000000 - Size.Width = 446.000000000000000000 + Size.Width = 374.000000000000000000 Size.Height = 291.000000000000000000 Size.PlatformDefault = False TabOrder = 0 @@ -255,7 +266,7 @@ object MainForm: TMainForm object Layout2: TLayout Align = Bottom Position.Y = 300.000000000000000000 - Size.Width = 466.000000000000000000 + Size.Width = 394.000000000000000000 Size.Height = 34.000000000000000000 Size.PlatformDefault = False TabOrder = 1 @@ -280,7 +291,7 @@ object MainForm: TMainForm Position.X = 3.000000000000000000 Position.Y = 94.000000000000000000 ShowCheck = False - Size.Width = 466.000000000000000000 + Size.Width = 394.000000000000000000 Size.Height = 20.000000000000000000 Size.PlatformDefault = False Text = 'Channels' @@ -351,7 +362,7 @@ object MainForm: TMainForm MinSize = 20.000000000000000000 Position.Y = 114.000000000000000000 ShowGrip = False - Size.Width = 472.000000000000000000 + Size.Width = 400.000000000000000000 Size.Height = 6.000000000000000000 Size.PlatformDefault = False end @@ -361,7 +372,7 @@ object MainForm: TMainForm MinSize = 20.000000000000000000 Position.Y = 474.000000000000000000 ShowGrip = False - Size.Width = 472.000000000000000000 + Size.Width = 400.000000000000000000 Size.Height = 6.000000000000000000 Size.PlatformDefault = False end @@ -374,7 +385,7 @@ object MainForm: TMainForm Position.X = 3.000000000000000000 Position.Y = 480.000000000000000000 ShowCheck = False - Size.Width = 466.000000000000000000 + Size.Width = 394.000000000000000000 Size.Height = 20.000000000000000000 Size.PlatformDefault = False Text = 'Debug' diff --git a/ProxyFormUnit.pas b/ProxyFormUnit.pas index 3fbe78e..d858ae5 100644 --- a/ProxyFormUnit.pas +++ b/ProxyFormUnit.pas @@ -66,7 +66,6 @@ TMainForm = class(TForm, IServiceConfigEvents) btnEditChannels: TButton; StyleBook1: TStyleBook; VertScrollBox1: TVertScrollBox; - eCetonTunerAddress: TEdit; Label1: TLabel; SaveTimer: TTimer; Label2: TLabel; @@ -99,6 +98,7 @@ TMainForm = class(TForm, IServiceConfigEvents) Label8: TLabel; HelpCallout: TCalloutRectangle; lblHelp: TLabel; + eCetonTunerAddress: TComboEdit; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure lbChannelsChangeCheck(Sender: TObject); @@ -130,8 +130,9 @@ TMainForm = class(TForm, IServiceConfigEvents) function GetClient: TCetonClient; - function GetLocalIPs: TArray; overload; - procedure GetLocalIPs(const aComboEdit: TComboEdit); overload; + function GetLocalIPs: TArray; + procedure UpdateLocalIPs(const aComboEdit: TComboEdit); + procedure UpdateDiscoveredCetonDevices(const aComboEdit: TComboEdit); function ExtractIP(const aComboEdit: TComboEdit): String; @@ -151,6 +152,7 @@ TMainForm = class(TForm, IServiceConfigEvents) // IServiceConfigEvents procedure Changed(const aSender: TObject; const aSections: TServiceConfigSections); procedure Log(const aMessage: String); + procedure DiscoveredCetonDevicesChanged; public { Public declarations } end; @@ -229,8 +231,9 @@ procedure TMainForm.FormCreate(Sender: TObject); fConfigManager := ProxyServiceModule.ConfigManager; fConfigManager.AddListener(Self); - GetLocalIPs(ceCetonListenIP); - GetLocalIPs(ceHDHRListenIP); + UpdateLocalIPs(ceCetonListenIP); + UpdateLocalIPs(ceHDHRListenIP); + UpdateDiscoveredCetonDevices(eCetonTunerAddress); ProxyServerModule.StartServer; end; @@ -447,7 +450,7 @@ procedure TMainForm.eCetonTunerAddressChangeTracking(Sender: TObject); begin ConfigManager.LockConfig(lConfig); try - lConfig.Ceton.TunerAddress := eCetonTunerAddress.Text; + lConfig.Ceton.TunerAddress := ExtractIP(eCetonTunerAddress); finally ConfigManager.UnlockConfig(lConfig); end; @@ -612,11 +615,17 @@ function TMainForm.GetLocalIPs: TArray; SetLength(Result, lCount); end; -procedure TMainForm.GetLocalIPs(const aComboEdit: TComboEdit); +procedure TMainForm.UpdateLocalIPs(const aComboEdit: TComboEdit); begin - aComboEdit.Items.Clear; - aComboEdit.Items.AddStrings(GetLocalIPs); - aComboEdit.RecalcSize; + aComboEdit.BeginUpdate; + try + aComboEdit.Items.Clear; + aComboEdit.Items.AddStrings(GetLocalIPs); + if aComboEdit.Count = 0 then + aComboEdit.Items.Add(''); + finally + aComboEdit.EndUpdate; + end; end; function TMainForm.ExtractIP(const aComboEdit: TComboEdit): String; @@ -752,4 +761,36 @@ procedure TMainForm.PanelMouseDown(Sender: TObject; Button: TMouseButton; TExpander(Sender).IsExpanded := not TExpander(Sender).IsExpanded; end; +procedure TMainForm.UpdateDiscoveredCetonDevices(const aComboEdit: TComboEdit); +var + lDevices: TArray; + i: Integer; +begin + aComboEdit.BeginUpdate; + try + aComboEdit.Items.Clear; + lDevices := ProxyServiceModule.DiscoveredCetonDeviceList.ToArray; + for i := 0 to High(lDevices) do + begin + if lDevices[i].FriendlyName <> '' then + aComboEdit.Items.Add(Format('%s (%s)', [lDevices[i].IP, lDevices[i].FriendlyName])) + else + aComboEdit.Items.Add(Format('%s', [lDevices[i].IP])); + end; + if aComboEdit.Count = 0 then + aComboEdit.Items.Add(''); + finally + aComboEdit.EndUpdate; + end; +end; + +procedure TMainForm.DiscoveredCetonDevicesChanged; +begin + TThread.ForceQueue(nil, + procedure() + begin + UpdateDiscoveredCetonDevices(eCetonTunerAddress); + end); +end; + end. diff --git a/ProxyServerModuleUnit.dfm b/ProxyServerModuleUnit.dfm index 528e6ac..2ccc162 100644 --- a/ProxyServerModuleUnit.dfm +++ b/ProxyServerModuleUnit.dfm @@ -9,8 +9,10 @@ object ProxyServerModule: TProxyServerModule Left = 88 Top = 56 end - object ServiceTimer: TTimer - OnTimer = ServiceTimerTimer + object RestartServersTimer: TTimer + Enabled = False + Interval = 2000 + OnTimer = RestartServersTimerTimer Left = 144 Top = 56 end diff --git a/ProxyServerModuleUnit.pas b/ProxyServerModuleUnit.pas index f69d9dd..404bcd8 100644 --- a/ProxyServerModuleUnit.pas +++ b/ProxyServerModuleUnit.pas @@ -5,10 +5,15 @@ interface uses System.SysUtils, System.Classes, + System.Diagnostics, + System.Generics.Collections, Winapi.ActiveX, FMX.Types, FMX.Dialogs, + REST.Client, + REST.Types, + IdHTTPWebBrokerBridge, IdBaseComponent, IdScheduler, @@ -22,6 +27,7 @@ interface IdTCPServer, IdSocketHandle, IdGlobal, + IdUDPClient, ProxyServiceModuleUnit, @@ -31,6 +37,7 @@ interface SocketUtils; const + SSDP_MULTICAST_GROUP = '239.255.255.250'; SSDP_PORT = 1900; type @@ -42,10 +49,10 @@ TIdCOMThread = class(TIdThreadWithTask) TProxyServerModule = class(TDataModule, IServiceConfigEvents) IdScheduler: TIdSchedulerOfThreadDefault; - ServiceTimer: TTimer; + RestartServersTimer: TTimer; procedure DataModuleCreate(Sender: TObject); procedure DataModuleDestroy(Sender: TObject); - procedure ServiceTimerTimer(Sender: TObject); + procedure RestartServersTimerTimer(Sender: TObject); private { Private declarations } fConfigManager: IServiceConfigManager; @@ -53,23 +60,25 @@ TProxyServerModule = class(TDataModule, IServiceConfigEvents) fServer: TIdHTTPWebBrokerBridge; fDiscoveryServer: TIdUDPServer; -// fSSDPServer: TIdIPMCastServer; fSSDPClient: TIdIPMCastClient; + fSSDPServer: TIdUDPServer; // fControlServer: TIdTCPServer; - fRestartServers: Boolean; - procedure DiscoveryUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle); procedure SSDPClientRead(Sender: TObject; const AData: TIdBytes; ABinding: TIdSocketHandle); + procedure SSDPServerRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle); procedure ControlTCPConnect(aContext: TIdContext); procedure ControlTCPExecute(aContext: TIdContext); procedure ServerException(AContext: TIdContext; AException: Exception); + function CreateSSDPDiscoverPacket: String; function TryCreateSSDPAlivePacket(const aRequestHost: String; out aPacket: String): Boolean; + procedure DiscoverCetonDevices; + function GetActive: Boolean; property ConfigManager: IServiceConfigManager read fConfigManager; @@ -78,6 +87,7 @@ TProxyServerModule = class(TDataModule, IServiceConfigEvents) // IServiceConfigEvents procedure Changed(const aSender: TObject; const aSections: TServiceConfigSections); procedure Log(const aMessage: String); + procedure DiscoveredCetonDevicesChanged; public { Public declarations } @@ -135,14 +145,18 @@ procedure TProxyServerModule.DataModuleCreate(Sender: TObject); fDiscoveryServer.ThreadedEvent := True; fDiscoveryServer.OnUDPRead := DiscoveryUDPRead; -// fSSDPServer := TIdIPMCastServer.Create(Self); -// fSSDPServer.MulticastGroup := '239.255.255.250'; - + // Used to respond to UPnP discovery requests for HDHomeRun and listen + // for "alive" messages fSSDPClient := TIdIPMCastClient.Create(Self); - fSSDPClient.MulticastGroup := '239.255.255.250'; + fSSDPClient.MulticastGroup := SSDP_MULTICAST_GROUP; fSSDPClient.OnIPMCastRead := SSDPClientRead; fSSDPClient.ThreadedEvent := True; + // Used to discover Ceton devices + fSSDPServer := TIdUDPServer.Create(Self); + fSSDPServer.ThreadedEvent := True; + fSSDPServer.OnUDPRead := SSDPServerRead; + // fControlServer := TIdTCPServer.Create(Self); // fControlServer.OnConnect := ControlTCPConnect; // fControlServer.OnExecute := ControlTCPExecute; @@ -151,6 +165,8 @@ procedure TProxyServerModule.DataModuleCreate(Sender: TObject); procedure TProxyServerModule.DataModuleDestroy(Sender: TObject); begin fConfigManager.RemoveListener(Self); + + fSSDPClient.Active := False; end; function TProxyServerModule.GetActive: Boolean; @@ -163,6 +179,7 @@ procedure TProxyServerModule.StartServer; lConfig: TServiceConfig; lListenIP: String; lHTTPPort: Integer; + lLocalIPs: TLocalIPInfoArray; lLocalIPInfo: TLocalIPInfo; begin if not fServer.Active then @@ -175,6 +192,8 @@ procedure TProxyServerModule.StartServer; ConfigManager.UnlockConfig(lConfig); end; + lLocalIPs := TSocketUtils.GetLocalIPs.Keep(4); + try fServer.Bindings.Clear; // Needed by NextPVR to find lineup.xml @@ -200,13 +219,12 @@ procedure TProxyServerModule.StartServer; begin // If listening on all IPs, have to explicitly create a binding for each local IP // so that we can properly read which IP that UDP packets come in on - for lLocalIPInfo in TSocketUtils.GetLocalIPs do - if lLocalIPInfo.IPVersion = 4 then - with fDiscoveryServer.Bindings.Add do - begin - IP := lLocalIPInfo.IP; - Port := HDHR_DISCOVERY_PORT; - end; + for lLocalIPInfo in lLocalIPs do + with fDiscoveryServer.Bindings.Add do + begin + IP := lLocalIPInfo.IP; + Port := HDHR_DISCOVERY_PORT; + end; end else begin @@ -235,24 +253,63 @@ procedure TProxyServerModule.StartServer; try fSSDPClient.Bindings.Clear; - with fSSDPClient.Bindings.Add do + + if lListenIP = '' then begin - IP := lListenIP; - Port := SSDP_PORT; + // If listening on all IPs, have to explicitly create a binding for each local IP + // so that we can properly read which IP that UDP packets come in on + for lLocalIPInfo in lLocalIPs do + with fSSDPClient.Bindings.Add do + begin + IP := lLocalIPInfo.IP; + Port := SSDP_PORT; + end; + end + else + begin + with fSSDPClient.Bindings.Add do + begin + IP := lListenIP; + Port := SSDP_PORT; + end; end; + fSSDPClient.ReuseSocket := rsTrue; fSSDPClient.Active := True; except TLogger.Log('Unable to bind SSDP listening port'); end; -{ try - fSSDPServer.BoundIP := lListenIP; - fSSDPServer.BoundPort := SSDP_PORT; + try + fSSDPServer.Bindings.Clear; + + if lListenIP = '' then + begin + // If listening on all IPs, have to explicitly create a binding for each local IP + // so that we can properly read which IP that UDP packets come in on + for lLocalIPInfo in lLocalIPs do + with fSSDPServer.Bindings.Add do + begin + IP := lLocalIPInfo.IP; + Port := 0; + end; + end + else + begin + with fSSDPServer.Bindings.Add do + begin + IP := lListenIP; + Port := 0; + end; + end; + fSSDPServer.Active := True; except - TLogger.Log('Unable to bind SSDP listening port'); - end;} + TLogger.Log('Unable to create SSDP server'); + end; + + // Send broadcast for UPnP devices + DiscoverCetonDevices; end; end; @@ -286,11 +343,12 @@ procedure TProxyServerModule.StopServer; // Ignore end; -{ try + try fSSDPServer.Active := False; + fSSDPServer.Bindings.Clear; except // Ignore - end;} + end; end; procedure TProxyServerModule.ServerException(AContext: TIdContext; @@ -377,22 +435,17 @@ procedure TProxyServerModule.Changed(const aSender: TObject; begin if TServiceConfigSection.Other in aSections then begin - fRestartServers := True; + RestartServersTimer.Enabled := True; end; end); end; -procedure TProxyServerModule.ServiceTimerTimer(Sender: TObject); +procedure TProxyServerModule.RestartServersTimerTimer(Sender: TObject); begin - if fRestartServers then - begin - fRestartServers := False; + RestartServersTimer.Enabled := False; - StopServer; - StartServer; - end; - -// fSSDPServer.Send(CreateSSDPAlivePacket); + StopServer; + StartServer; end; function TProxyServerModule.TryGetAddress(const aRequestLocalIP: String; out aAddress: String): Boolean; @@ -463,20 +516,92 @@ procedure TProxyServerModule.ControlTCPExecute(aContext: TIdContext); TLogger.Log('Control execute'); end; -// Received SSDP data from 192.168.1.89: M-SEARCH * HTTP/1.1 -// MX: 5 -// ST: upnp:rootdevice -// MAN: "ssdp:discover" -// User-Agent: Linux/3.0.13 UPnP/1.0 LGE_DLNA_SDK/1.6.0 [TV][LG]55LA7400-UD/05.09.11 DLNADOC/1.50 -// DLNADeviceName.lge.com: %5bTV%5d%5bLG%5d55LA7400-UD -// Connection: close -// Host: 239.255.255.250:1900 +{Description: Ceton InfiniTV MOCUR (00-00-22-00-00-XX-XX-XX) +DeviceType: urn:schemas-cetoncorp-com:device:SecureContainer:1 +FriendlyName: Ceton InfiniTV Ethernet (00-XX-XX-XX) +Manufacturer: Ceton Corporation +ManufacturerUrl: http://www.cetoncorp.com/ +ModelName: Ceton InfiniTV MOCUR (00-00-22-00-00-XX-XX-XX) +ModelNumber: 0.0.0.9 +PresentationUrl: http://192.168.1.132/Services/System.html +SerialNumber: 00-00-22-00-00-XX-XX-XX +UDN: uuid:XXX-XXX-XXX +} +{Process cetonproxy.exe (25300) +Debug Output: +[2020-03-08 14:29:28.305] Received NOTIFY from 192.168.1.132 on 192.168.1.8: NOTIFY * HTTP/1.1 +HOST: 239.255.255.250:1900 +CACHE-CONTROL: max-age=1800 +LOCATION: http://192.168.1.132/description.xml +NT: uuid:89333102-EBE5-11D8-AC9A-000008098100 +NTS: ssdp:alive +SERVER: Linux/3.0.1+, UPnP/1.0 +USN: uuid:XXX-XXX-XXX +} +{Process cetonproxy.exe (25300) +Debug Output: +[2020-03-08 14:29:28.302] Received NOTIFY from 192.168.1.132 on 192.168.1.8: NOTIFY * HTTP/1.1 +HOST: 239.255.255.250:1900 +CACHE-CONTROL: max-age=1800 +LOCATION: http://192.168.1.132/description.xml +NT: upnp:rootdevice +NTS: ssdp:alive +SERVER: Linux/3.0.1+, UPnP/1.0 +USN: uuid:XXX-XXX-XXX::upnp:rootdevice +} +{Debug Output: +[2020-03-08 14:29:28.309] Received NOTIFY from 192.168.1.132 on 192.168.1.116: NOTIFY * HTTP/1.1 +HOST: 239.255.255.250:1900 +CACHE-CONTROL: max-age=1800 +LOCATION: http://192.168.1.132/description.xml +NT: upnp:rootdevice +NTS: ssdp:alive +SERVER: Linux/3.0.1+, UPnP/1.0 +USN: uuid:XXX-XXX-XXX::upnp:rootdevice +} +{[2020-03-08 14:29:28.313] Received NOTIFY from 192.168.1.132 on 192.168.1.8: NOTIFY * HTTP/1.1 +HOST: 239.255.255.250:1900 +CACHE-CONTROL: max-age=1800 +LOCATION: http://192.168.1.132/description.xml +NT: urn:schemas-cetoncorp-com:device:SecureContainer:1 +NTS: ssdp:alive +SERVER: Linux/3.0.1+, UPnP/1.0 +USN: uuid:XXX-XXX-XXX::urn:schemas-cetoncorp-com:device:SecureContainer:1 +} +{Debug Output: +[2020-03-08 14:51:25.922] Received M-SEARCH from 192.168.1.10 on 192.168.1.8: M-SEARCH * HTTP/1.1 +Host: 239.255.255.250:1900 +ST: urn:schemas-cetoncorp-com:device:SecureContainer:1 +Man: "ssdp:discover" +MX: 3 +} +{Debug Output: +[2020-03-08 14:51:26.021] Received M-SEARCH from 192.168.1.10 on 192.168.1.8: M-SEARCH * HTTP/1.1 +Host: 239.255.255.250:1900 +ST: uuid:89333102-EBE5-11D8-AC9A-000008085F10 +Man: "ssdp:discover" +MX: 3 +} + +function TProxyServerModule.CreateSSDPDiscoverPacket: String; +const + cSSDPDiscover = + 'M-SEARCH * HTTP/1.1'#13#10+ + 'Host: 239.255.255.250:1900'#13#10+ + 'ST: urn:schemas-cetoncorp-com:device:SecureContainer:1'#13#10+ + 'Man: "ssdp:discover"'#13#10+ + 'MX: 3'#13#10#13#10; +begin + Result := Format(cSSDPDiscover, []); +end; procedure TProxyServerModule.SSDPClientRead(Sender: TObject; const AData: TIdBytes; ABinding: TIdSocketHandle); var lData: UTF8String; lPacket: String; + lValues: TStringList; + lLocation: String; begin if Length(AData) > 0 then begin @@ -493,6 +618,26 @@ procedure TProxyServerModule.SSDPClientRead(Sender: TObject; if TryCreateSSDPAlivePacket(ABinding.IP, lPacket) then fDiscoveryServer.Send(ABinding.PeerIP, ABinding.PeerPort, lPacket); end; + end + else if String(lData).StartsWith('NOTIFY', True) then + begin + if String(lData).Contains('NT: urn:schemas-cetoncorp-com:device:SecureContainer:1') then + begin + TLogger.LogFmt('Received NOTIFY from ceton device %s on %s: %s', [ABinding.PeerIP, ABinding.IP, String(lData)]); + + lValues := TStringList.Create; + try + lValues.CaseSensitive := False; + lValues.NameValueSeparator := ':'; + lValues.Text := String(lData); + + lLocation := Trim(lValues.Values['LOCATION']); + if lLocation <> '' then + ProxyServiceModule.CetonDeviceDiscovered(ABinding.PeerIP, lLocation); + finally + lValues.Free; + end; + end; end; end; end; @@ -545,4 +690,63 @@ procedure TProxyServerModule.Log(const aMessage: String); // Nothing end; +procedure TProxyServerModule.DiscoverCetonDevices; +var + i: Integer; +begin + if fSSDPServer.Active then + begin + ProxyServiceModule.DiscoveredCetonDeviceList.DiscoveryStarted; + + for i := 0 to fSSDPServer.Bindings.Count-1 do + fSSDPServer.Bindings[i].SendTo(SSDP_MULTICAST_GROUP, SSDP_PORT, CreateSSDPDiscoverPacket); + end; +end; + +{Debug Output: +[2020-03-08 21:09:18.964] Ceton Incoming from 192.168.1.116: HTTP/1.1 200 OK +CACHE-CONTROL: max-age=300 +DATE: Thu, 15 Jan 1970 03:19:09 GMT +EXT: +LOCATION: http://192.168.1.132/description.xml +SERVER: Linux/3.0.1+, UPnP/1.0 +ST: urn:schemas-cetoncorp-com:device:SecureContainer:1 +USN: uuid:XXX-XXX-XXX::urn:schemas-cetoncorp-com:device:SecureContainer:1} + +procedure TProxyServerModule.SSDPServerRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle); +var + lData: UTF8String; + lValues: TStringList; + lLocation: String; +begin + if Length(AData) > 0 then + begin + SetLength(lData, Length(AData)); + Move(AData[0], lData[Low(lData)], Length(AData)); + + TLogger.LogFmt('Received SSDP discovery response from %s on %s: %s', [ABinding.PeerIP, ABinding.IP, String(lData)]); + + lValues := TStringList.Create; + try + lValues.CaseSensitive := False; + lValues.NameValueSeparator := ':'; + lValues.Text := String(lData); + + if SameText(Trim(lValues.Values['ST']), 'urn:schemas-cetoncorp-com:device:SecureContainer:1') then + begin + lLocation := Trim(lValues.Values['LOCATION']); + + ProxyServiceModule.CetonDeviceDiscovered(ABinding.PeerIP, lLocation); + end; + finally + lValues.Free; + end; + end; +end; + +procedure TProxyServerModule.DiscoveredCetonDevicesChanged; +begin + // Nothing +end; + end. diff --git a/ProxyServiceModuleUnit.pas b/ProxyServiceModuleUnit.pas index ca3fe76..5a8d718 100644 --- a/ProxyServiceModuleUnit.pas +++ b/ProxyServiceModuleUnit.pas @@ -13,13 +13,20 @@ interface System.Generics.Collections, System.Generics.Defaults, System.SyncObjs, + System.Diagnostics, FMX.Types, + Winapi.ActiveX, + + REST.Client, REST.Types, REST.Json, REST.Json.Types, REST.JsonReflect, + Xml.XmlDoc, + Xml.XmlIntf, + IdStack, HDHR, @@ -73,6 +80,7 @@ TServiceConfig = class(TPersistent) IServiceConfigEvents = interface ['{E51631F5-FC88-4FEC-BCF6-9A0F5616CE79}'] procedure Changed(const aSender: TObject; const aSections: TServiceConfigSections); + procedure DiscoveredCetonDevicesChanged; procedure Log(const aMessage: String); end; @@ -83,6 +91,7 @@ TServiceConfig = class(TPersistent) procedure Log(const aMessage: String); procedure Changed(const aSender: TObject; const aSections: TServiceConfigSections); + procedure DiscoveredCetonDevicesChanged; procedure AddListener(const aListener: IServiceConfigEvents); procedure RemoveListener(const aListener: IServiceConfigEvents); @@ -102,6 +111,7 @@ TServiceConfigManager = class(TInterfacedObject, IServiceConfigManager) procedure Log(const aMessage: String); procedure Changed(const aSender: TObject; const aSections: TServiceConfigSections); + procedure DiscoveredCetonDevicesChanged; procedure AddListener(const aListener: IServiceConfigEvents); procedure RemoveListener(const aListener: IServiceConfigEvents); @@ -117,9 +127,12 @@ TServiceThread = class(TThread, IInterface, IServiceConfigEvents) fServiceModule: TProxyServiceModule; fChangeEvent: TEvent; fConfigChanged: Boolean; + fCetonDeviceDiscovered: Boolean; fLogCache: TStringBuilder; procedure SaveLog; + + procedure QueryDiscoveredCetonDevices; protected // IInterface function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; @@ -129,10 +142,13 @@ TServiceThread = class(TThread, IInterface, IServiceConfigEvents) // IServiceConfigEvents procedure Changed(const aSender: TObject; const aSections: TServiceConfigSections); procedure Log(const aMessage: String); + procedure DiscoveredCetonDevicesChanged; public constructor Create(const aServiceModule: TProxyServiceModule); destructor Destroy; override; + procedure CetonDeviceDiscovered; + procedure Execute; override; end; @@ -144,6 +160,7 @@ TProxyServiceModule = class(TDataModule, IServiceConfigEvents, ILogger) fConfigManager: IServiceConfigManager; fClient: TCetonClient; fThread: TServiceThread; + fDiscoveredCetonDeviceList: TDiscoveredCetonDeviceList; protected procedure LoadConfig; procedure SaveConfig; @@ -153,6 +170,7 @@ TProxyServiceModule = class(TDataModule, IServiceConfigEvents, ILogger) // IServiceConfigEvents procedure Changed(const aSender: TObject; const aSections: TServiceConfigSections); procedure Log(const aMessage: String); + procedure DiscoveredCetonDevicesChanged; // ILogger procedure ILogger.Log = HandleLoggerLog; @@ -162,6 +180,10 @@ TProxyServiceModule = class(TDataModule, IServiceConfigEvents, ILogger) property ConfigManager: IServiceConfigManager read fConfigManager; property Client: TCetonClient read fClient; + property DiscoveredCetonDeviceList: TDiscoveredCetonDeviceList read fDiscoveredCetonDeviceList; + + procedure CetonDeviceDiscovered(const aIP, aDescriptionXMLURL: String); + function GetConfigPath: String; end; @@ -378,10 +400,27 @@ procedure TServiceConfigManager.Log(const aMessage: String); end; end; +procedure TServiceConfigManager.DiscoveredCetonDevicesChanged; +var + i: Integer; +begin + Lock; + try + for i := 0 to fEventListeners.Count-1 do + begin + fEventListeners[i].DiscoveredCetonDevicesChanged; + end; + finally + Unlock; + end; +end; + { TProxyServiceModule } procedure TProxyServiceModule.DataModuleCreate(Sender: TObject); begin + fDiscoveredCetonDeviceList := TDiscoveredCetonDeviceList.Create; + fConfigManager := TServiceConfigManager.Create; try @@ -413,6 +452,8 @@ procedure TProxyServiceModule.DataModuleDestroy(Sender: TObject); fClient.Free; + fDiscoveredCetonDeviceList.Free; + SaveConfig; TLogger.Log('Closing cetonproxy'); @@ -567,6 +608,34 @@ procedure TProxyServiceModule.MoveLog; end; end; +procedure TProxyServiceModule.CetonDeviceDiscovered(const aIP, + aDescriptionXMLURL: String); +var + lDevice: TDiscoveredCetonDevice; +begin + lDevice := DiscoveredCetonDeviceList.FindByIP(aIP); + if aDescriptionXMLURL <> lDevice.DescriptionXMLURL then + begin + lDevice.IP := aIP; + lDevice.DescriptionXMLURL := aDescriptionXMLURL; + lDevice.Queried := False; + lDevice.FriendlyName := ''; + lDevice.UpdateTicks := TStopWatch.GetTimestamp; + DiscoveredCetonDeviceList.Update(lDevice); + + fThread.CetonDeviceDiscovered; + end + else + begin + lDevice.UpdateTicks := TStopWatch.GetTimestamp; + DiscoveredCetonDeviceList.Update(lDevice); + end; +end; + +procedure TProxyServiceModule.DiscoveredCetonDevicesChanged; +begin + // Nothing +end; { TServiceThread } @@ -604,27 +673,98 @@ destructor TServiceThread.Destroy; inherited; end; -procedure TServiceThread.Execute; +procedure TServiceThread.QueryDiscoveredCetonDevices; +var + lClient: TRESTClient; + lDeviceArray: TArray; + lDevice: TDiscoveredCetonDevice; + i: Integer; + lRequest: TRESTRequest; begin - while not Terminated do - begin - fChangeEvent.WaitFor(1000); + lDeviceArray := fServiceModule.DiscoveredCetonDeviceList.ToArray; - if fConfigChanged then + for i := 0 to High(lDeviceArray) do + begin + if not lDeviceArray[i].Queried then begin - fConfigChanged := False; + lDevice := lDeviceArray[i]; - fServiceModule.SaveConfig; + try + lClient := TRESTClient.Create(lDevice.DescriptionXMLURL); + try + lRequest := TRESTRequest.Create(nil); + try + lRequest.Timeout := 3000; + + lRequest.Client := lClient; + lRequest.Method := TRESTRequestMethod.rmGet; + // lRequest.Resource := 'Services/6/Status.html'; + + lRequest.Execute; + + if lRequest.Response.StatusCode = 200 then + begin + try + TDiscoveredCetonDevice.UpdateFromDescriptionXML(lDevice, lRequest.Response.Content); + finally + lDevice.Queried := True; + fServiceModule.DiscoveredCetonDeviceList.Update(lDevice); + end; + end + else + TLogger.LogFmt('Unable to reach %s at discovered Ceton device with IP %s: Received status code %d (%s)', [lDevice.DescriptionXMLURL, lDevice.IP, lRequest.Response.StatusCode, lRequest.Response.StatusText]); + finally + lRequest.Free; + end; + finally + lClient.Free; + end; + except + on e: Exception do + TLogger.LogFmt('Unable to reach %s at discovered Ceton device with IP %s: %s', [lDevice.DescriptionXMLURL, lDevice.IP, e.Message]); + end; end; + end; +end; - SaveLog; +procedure TServiceThread.Execute; +begin + Coinitialize(nil); + try + while not Terminated do + begin + fChangeEvent.WaitFor(1000); - try - fServiceModule.Client.CheckTuner; - except - on e: Exception do - TLogger.Log(e.Message); + if fConfigChanged then + begin + fConfigChanged := False; + + fServiceModule.SaveConfig; + end; + + SaveLog; + + try + fServiceModule.Client.CheckTuner; + except + on e: Exception do + TLogger.Log(e.Message); + end; + + if fCetonDeviceDiscovered then + begin + fCetonDeviceDiscovered := False; + + QueryDiscoveredCetonDevices; + + fServiceModule.ConfigManager.DiscoveredCetonDevicesChanged; + end; + + if fServiceModule.DiscoveredCetonDeviceList.Clean then + fServiceModule.ConfigManager.DiscoveredCetonDevicesChanged; end; + finally + CoUninitialize; end; end; @@ -693,4 +833,14 @@ procedure TServiceThread.SaveLog; end; end; +procedure TServiceThread.CetonDeviceDiscovered; +begin + fCetonDeviceDiscovered := True; +end; + +procedure TServiceThread.DiscoveredCetonDevicesChanged; +begin + // Nothing +end; + end. diff --git a/SocketUtils.pas b/SocketUtils.pas index ed4e4ff..77ce987 100644 --- a/SocketUtils.pas +++ b/SocketUtils.pas @@ -189,6 +189,7 @@ TLocalIPInfoArrayHelper = record helper for TLocalIPInfoArray function LowestMetric(const aIPVersion: Byte): TLocalIPInfo; function Remove(const aIP: String): TLocalIPInfoArray; + function Keep(const aIPVersion: Byte): TLocalIPInfoArray; end; TSocketUtils = class abstract @@ -883,4 +884,20 @@ function TLocalIPInfoArrayHelper.Remove(const aIP: String): TLocalIPInfoArray; Result := Self; end; +function TLocalIPInfoArrayHelper.Keep( + const aIPVersion: Byte): TLocalIPInfoArray; +var + i, lCount: Integer; +begin + SetLength(Result, Length(Self)); + lCount := 0; + for i := 0 to High(Self) do + if not Self[i].IPVersion <> aIPVersion then + begin + Result[lCount] := Self[i]; + Inc(lCount); + end; + SetLength(Result, lCount); +end; + end. diff --git a/ceton/Ceton.pas b/ceton/Ceton.pas index c9f792c..a9eddbd 100644 --- a/ceton/Ceton.pas +++ b/ceton/Ceton.pas @@ -42,6 +42,8 @@ interface cStatsUpdateIntervalMs = 500; + cCetonDiscoveryDiscardDeviceMs = 10000; + type ECetonClosedError = class(Exception); ECetonError = class(Exception); @@ -380,6 +382,31 @@ TCetonVideoStream = class(TStream) function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; end; + TDiscoveredCetonDevice = record + IP: String; + DescriptionXMLURL: String; + Queried: Boolean; + FriendlyName: String; + UpdateTicks: Int64; + class procedure UpdateFromDescriptionXML(var aDevice: TDiscoveredCetonDevice; const aXMLContent: String); static; + end; + + TDiscoveredCetonDeviceList = class + private + fList: TList; + fLastDiscoveryTicks: Int64; + procedure Lock; + procedure Unlock; + public + constructor Create; + destructor Destroy; override; + procedure Update(const aDevice: TDiscoveredCetonDevice); + procedure DiscoveryStarted; + function Clean: Boolean; + function FindByIP(const aIP: String): TDiscoveredCetonDevice; + function ToArray: TArray; + end; + implementation { TChannelMap } @@ -1775,4 +1802,136 @@ function TTunerStats.CreateClient(const aIndex: Integer): PTunerClientStats; Result.Active := True; end; +{ TDiscoveredCetonDeviceList } + +constructor TDiscoveredCetonDeviceList.Create; +begin + fList := TList.Create; +end; + +procedure TDiscoveredCetonDeviceList.Lock; +begin + TMonitor.Enter(Self); +end; + +procedure TDiscoveredCetonDeviceList.Unlock; +begin + TMonitor.Exit(Self); +end; + +destructor TDiscoveredCetonDeviceList.Destroy; +begin + fList.Free; + + inherited; +end; + +procedure TDiscoveredCetonDeviceList.Update(const aDevice: TDiscoveredCetonDevice); +var + i: Integer; + lIndex: Integer; +begin + Lock; + try + lIndex := -1; + for i := 0 to fList.Count-1 do + begin + if SameText(fList[i].IP, aDevice.IP) then + begin + lIndex := i; + Break; + end; + end; + + if lIndex = -1 then + fList.Add(aDevice) + else + begin + fList[lIndex] := aDevice; + end; + finally + Unlock; + end; +end; + +function TDiscoveredCetonDeviceList.Clean: Boolean; +var + i: Integer; +begin + Result := False; + Lock; + try + for i := fList.Count-1 downto 0 do + begin + if fList[i].UpdateTicks < fLastDiscoveryTicks-cCetonDiscoveryDiscardDeviceMs then + begin + fList.Delete(i); + Result := True; + end; + end; + finally + Unlock; + end; +end; + +procedure TDiscoveredCetonDeviceList.DiscoveryStarted; +begin + Lock; + try + fLastDiscoveryTicks := TStopwatch.GetTimeStamp; + finally + Unlock; + end; +end; + +function TDiscoveredCetonDeviceList.ToArray: TArray; +begin + Lock; + try + Result := fList.ToArray; + finally + Unlock; + end; +end; + +function TDiscoveredCetonDeviceList.FindByIP( + const aIP: String): TDiscoveredCetonDevice; +var + i: Integer; +begin + Lock; + try + for i := 0 to fList.Count-1 do + if SameText(fList[i].IP, aIP) then + Exit(fList[i]); + Result := Default(TDiscoveredCetonDevice); + finally + Unlock; + end; +end; + +{ TDiscoveredCetonDevice } + +class procedure TDiscoveredCetonDevice.UpdateFromDescriptionXML( + var aDevice: TDiscoveredCetonDevice; const aXMLContent: String); +var + lXML: IXMLDocument; + lRootNode, lDeviceNode, lNode: IXMLNode; +begin + lXML := TXMLDocument.Create(nil); + lXML.LoadFromXML(aXMLContent); + + lRootNode := lXML.ChildNodes.FindNode('root'); + if Assigned(lRootNode) then + begin + lDeviceNode := lRootNode.ChildNodes.FindNode('device'); + if Assigned(lDeviceNode) then + begin + lNode := lDeviceNode.ChildNodes.FindNode('friendlyName'); + if Assigned(lNode) then + aDevice.FriendlyName := lNode.Text; + end; + end; +end; + end. diff --git a/cetonproxy.dproj b/cetonproxy.dproj index bbe7fa9..c961d94 100644 --- a/cetonproxy.dproj +++ b/cetonproxy.dproj @@ -5,7 +5,7 @@ FMX cetonproxy.dpr True - Debug + Release Win32 1 Application