Redirigir los puertos del router con UPnP. ¿Realmente es posible?

[espinete]

Unidad "Uupnp.pas"

Código Delphi [-]
unit UuPnP;

interface

uses
  System.SysUtils, System.Classes, idGlobal, MSXML, ComObj;

type
  TDebugEvent = procedure(const aText: String) of object;

  TuPnP = class(TComponent)
  private const
    WAN_IP_CONN_SERVICE = 'WANIPConnection:1';
    WAN_PPP_CONN_SERVICE = 'WANPPPConnection:1';
    WAN_IP_CONN_SERVICE_TYPE = 'urn:schemas-upnp-org:service:WANIPConnection:1';
  private
    FDeviceIP: String;
    FDevicePort: TIdPort;
    FDeviceControlURL: String;
    FExternalIP: String;
    FOnDebug: TDebugEvent;
    function GetDiscovered: Boolean;
  public
    FfriendlyName: String;
    Fmanufacturer: String;
    FmodelName: String;
    constructor Create(AOwner: TComponent); override;

    procedure Discover;
    function AddPortMapping(const aPort: TIdPort;desc:string): Boolean;
    procedure DeletePortMapping(const aPort: TIdPort);
    function GetExternalIP: String;

    property Discovered: Boolean read GetDiscovered;

    property OnDebug: TDebugEvent read FOnDebug write FOnDebug;
  end;

implementation

uses IdStack, IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient,
  IdTCPConnection, IdTCPClient, IdHTTP, IdUri;

{ TuPnP }

function TuPnP.AddPortMapping(const aPort: TIdPort;desc:string): Boolean;
var
  LNet: TIdTCPClient;
  LResponseStr: String;
  LSendData: TStringStream;
  LHeaderStr: String;
begin
  Result := False;

  try
    LNet := TIdTCPClient.Create(Self);
    LSendData := TStringStream.Create('');

    LSendData.WriteString('');
    LSendData.WriteString('');
    LSendData.WriteString('');
    LSendData.WriteString(Format('', [WAN_IP_CONN_SERVICE_TYPE]));

    LSendData.WriteString('');
    LSendData.WriteString(Format('%d', [aPort]));
    LSendData.WriteString(Format('%s', ['TCP']));
    LSendData.WriteString(Format('%d', [aPort]));
    LSendData.WriteString(Format('%s', [GStack.LocalAddress]));
    LSendData.WriteString(Format('%d', [1]));
    LSendData.WriteString(Format('%s', [desc]));
    LSendData.WriteString(Format('%d', [0]));

    LSendData.WriteString('');
    LSendData.WriteString('');
    LSendData.WriteString('');

    LHeaderStr := 'POST %s HTTP/1.1' + EOL
      + 'HOST: %s:%d' + EOL
      + 'SOAPACTION: "%s"' + EOL
      + 'CONTENT-TYPE: text/xml ; charset="utf-8"'+ EOL
      + 'CONTENT-LENGTH: %d'+ EOL
      + EOL;
    LHeaderStr := Format(LHeaderStr, [FDeviceControlURL, FDeviceIP, FDevicePort,
      WAN_IP_CONN_SERVICE_TYPE + '#' + 'AddPortMapping', LSendData.Size]);

    // �������
    if Assigned(FOnDebug) then
    begin
      FOnDebug('[AddPortMapping] ' + LHeaderStr + LSendData.DataString);
    end;

    try
      LNet.Host := FDeviceIP;
      LNet.Port := FDevicePort;
      LNet.Connect;
      if LNet.Connected then
      begin
        // �������� ������
        LNet.IOHandler.WriteLn(LHeaderStr + LSendData.DataString, IndyTextEncoding_UTF8);

        // �������� �����
        LResponseStr := LNet.IOHandler.ReadLn(LF, 1000 * 10);

        // ��������� �����
        if (Pos('200 OK', LResponseStr) <> 0) then
        begin
            Result := True;
        end;

//        if LNet.IOHandler.CheckForDataOnSource(1000) then
//        begin
//          LResponseStr := LNet.IOHandler.ReadString(LNet.IOHandler.InputBuffer.Size);
//          // ��������� ������� ���� �������� �����
//          if LNet.IOHandler.CheckForDataOnSource(1000) then
//          begin
//            LResponseStr := LNet.IOHandler.ReadString(LNet.IOHandler.InputBuffer.Size);
//          end;
//        end;
      end;

      // �������
      if Assigned(FOnDebug) then
      begin
        FOnDebug('[AddPortMapping] ' + LResponseStr);
      end;

      // ��������� �����
//      if (LResponseStr <> '') then
//      begin
//        LXml := CreateXMLDoc;
//        LXml.LoadFromXML(LResponseStr);
//        LNNode := LXml.DocumentElement.SelectNode('//u:AddPortMappingResponse');
//        if Assigned(LNNode) then
//        begin
//          Result := True;
//        end;
//      end;
    except
      on E: Exception do
      begin
        // �������
        if Assigned(FOnDebug) then
        begin
          FOnDebug('[AddPortMapping] ' + E.Message);
        end;
      end;
    end;
  finally
    FreeAndNil(LNet);
    FreeAndNil(LSendData);
  end;
end;

constructor TuPnP.Create(AOwner: TComponent);
begin
  inherited;
  FDeviceIP := '';
  FDevicePort := 0;
  FExternalIP := '';
end;

procedure TuPnP.DeletePortMapping(const aPort: TIdPort);
var
  LNet: TIdTCPClient;
  LResponseStr: String;
  LHeaderStr: String;
  LSendData: TStringStream;
begin
  try
    LNet := TIdTCPClient.Create(Self);
    LSendData := TStringStream.Create('');

    LSendData.WriteString('');
    LSendData.WriteString('');
    LSendData.WriteString('');
    LSendData.WriteString(Format('eletePortMapping xmlns:u="%s">', [WAN_IP_CONN_SERVICE_TYPE]));

    LSendData.WriteString('');
    LSendData.WriteString(Format('%d', [aPort]));
    LSendData.WriteString(Format('%s', ['TCP']));

    LSendData.WriteString('eletePortMapping>');
    LSendData.WriteString('');
    LSendData.WriteString('');

    LHeaderStr := 'POST %s HTTP/1.1' + EOL
      + 'HOST: %s:%d' + EOL
      + 'SOAPACTION: "%s"' + EOL
      + 'CONTENT-TYPE: text/xml ; charset="utf-8"'+ EOL
      + 'CONTENT-LENGTH: %d'+ EOL
      + EOL;
    LHeaderStr := Format(LHeaderStr, [FDeviceControlURL, FDeviceIP, FDevicePort,
      WAN_IP_CONN_SERVICE_TYPE + '#' + 'DeletePortMapping', LSendData.Size]);

    // �������
    if Assigned(FOnDebug) then
    begin
      FOnDebug('[DeletePortMapping] ' + LHeaderStr + LSendData.DataString);
    end;

    try
      LNet.Host := FDeviceIP;
      LNet.Port := FDevicePort;
      LNet.Connect;
      if LNet.Connected then
      begin
        // �������� ������
        LNet.IOHandler.WriteLn(LHeaderStr + LSendData.DataString, IndyTextEncoding_UTF8);

        // �������� �����
        LResponseStr := LNet.IOHandler.ReadLn(LF, 1000 * 10);

        // ��������� �����
        if (Pos('200 OK', LResponseStr) <> 0) then
        begin
          //Result := True;
        end;

        // �������� �����
//        if LNet.IOHandler.CheckForDataOnSource(1000) then
//        begin
//          LResponseStr := LNet.IOHandler.ReadString(LNet.IOHandler.InputBuffer.Size);
//          // ��������� ������� ���� �������� �����
//          if LNet.IOHandler.CheckForDataOnSource(1000) then
//          begin
//            LResponseStr := LNet.IOHandler.ReadString(LNet.IOHandler.InputBuffer.Size);
//          end;
//        end;
      end;

      // �������
      if Assigned(FOnDebug) then
      begin
        FOnDebug('[DeletePortMapping] ' + LResponseStr);
      end;
    except
      on E: Exception do
      begin
        // �������
        if Assigned(FOnDebug) then
        begin
          FOnDebug('[DeletePortMapping] ' + E.Message);
        end;
      end;
    end;
  finally
    FreeAndNil(LNet);
    FreeAndNil(LSendData);
  end;
end;

procedure TuPnP.Discover;
var
  LNet: TIdUDPClient;
  LSendStr: String;
  LResponseStr: String;
  LPeerIP: String;
  LPeerPort: Word;
  LHttp: TIdHTTP;
  LStartIdx, LCount: Integer;
  LUri: TIdURI;
  LXml: IXMLDOMDocument;
  LNControlURL: IXMLDomNode;
  LNService: IXMLDomNode;
  LNServiceType: IXMLDomNode;
  LNodeList: IXMLDomNodeList;
  i: Integer;
begin
  LSendStr := 'M-SEARCH * HTTP/1.1' + EOL
    + 'MX: 2' + EOL
    + 'HOST: 239.255.255.250:1900' + EOL
    + 'MAN: "ssdp:discover"' + EOL
    + 'ST: urn:schemas-upnp-org:service:%s'+ EOL
    + EOL;

  try
    LNet := TIdUDPClient.Create(Self);
    LHttp := TIdHTTP.Create(Self);
    LUri := TIdURI.Create('');

    // ������ ����������������� ��������
    LNet.BoundIP := GStack.LocalAddress;
    LNet.Send('239.255.255.250', 1900, Format(LSendStr, [WAN_IP_CONN_SERVICE]));
    //LNet.Send('239.255.255.250', 1900, Format(LSendStr, [WAN_PPP_CONN_SERVICE]));

    // ��������� �����, ���� ������ ���� <> 0
    LPeerPort := 0;
    LNet.ReceiveTimeout := 1000;
    repeat
      LResponseStr := LNet.ReceiveString(LPeerIP, LPeerPort);
      if LPeerPort <> 0 then
      begin
        // �������
        if Assigned(FOnDebug) then
        begin
          FOnDebug('[Discover] ' + LResponseStr);
          FOnDebug('[Discover] ' + 'PeerPort: ' + IntToStr(LPeerPort));
        end;

        // ��������� ������ ��� ��������
        LStartIdx := Pos('LOCATION:', LResponseStr);
        if (LStartIdx <> 0) then
        begin
          LStartIdx := LStartIdx + Length('LOCATION:') + 1;
          LCount := Pos(EOL, LResponseStr, LStartIdx) - LStartIdx;
          LUri.URI := Copy(LResponseStr, LStartIdx, LCount);

          // �������
          if Assigned(FOnDebug) then
          begin
            FOnDebug('[Discover] ' + 'URI: ' + LUri.URI);
          end;

          // ���������� ������ � �����
          FDeviceIP := LUri.Host;
          FDevicePort := StrToInt(LUri.Port);

          // �������
          if Assigned(FOnDebug) then
          begin
            FOnDebug('[Discover] ' + 'DeviceIP: ' + FDeviceIP);
            FOnDebug('[Discover] ' + 'DevicePort: ' + IntToStr(FDevicePort));
          end;

          // ������ ����� ��������
          LResponseStr := LHttp.Get(LUri.URI);
          if (LResponseStr <> '') then
          begin
            // �������
            if Assigned(FOnDebug) then
            begin
              FOnDebug('[Discover] ' + LResponseStr);
            end;

            LXml := CreateOleObject('Microsoft.XMLDOM') as IXMLDOMDocument;
            LXml.LoadXML(LResponseStr);

            //Obtenemos información del dispositivo
            try
                LNodeList := LXml.SelectNodes('//device');
                LNService := LNodeList[0];
                LNServiceType := LNService.SelectSingleNode('friendlyName');
                if Assigned(LNServiceType) then
                    Ffriendlyname := LNServiceType.childNodes[0].nodeValue;
                LNServiceType := LNService.SelectSingleNode('manufacturer');
                if Assigned(LNServiceType) then
                    Fmanufacturer := LNServiceType.childNodes[0].nodeValue;
                LNServiceType := LNService.SelectSingleNode('modelName');
                if Assigned(LNServiceType) then
                    FmodelName := LNServiceType.childNodes[0].nodeValue;
            except
            end;

            //Recorre los "servicios" encontrados y localiza el WAN_IP_CONN_SERVICE
            LNodeList := LXml.SelectNodes('//serviceList/service');
            for i := 0 to LNodeList.length - 1 do
            begin
                LNService := LNodeList[i];
                LNServiceType := LNService.SelectSingleNode('serviceType');
                if Assigned(LNServiceType) and (LNServiceType.ChildNodes[0].NodeValue = WAN_IP_CONN_SERVICE_TYPE) then
                begin
                    LNControlURL := LNService.SelectSingleNode('controlURL');
                    if Assigned(LNControlURL) then
                    begin
                      FDeviceControlURL := LNControlURL.ChildNodes[0].NodeValue;

                      // �������
                      if Assigned(FOnDebug) then
                      begin
                        FOnDebug('[Discover] ' + 'DeviceControlURL: ' + FDeviceControlURL);
                      end;
                      Break;
                    end;
                end;
            end;
          end;
        end;
      end;
    until LPeerPort = 0;
  finally
    FreeAndNil(LNet);
    FreeAndNil(LHttp);
    FreeAndNil(LUri);
  end;
end;

function TuPnP.GetDiscovered: Boolean;
begin
  Result := (FDeviceIP <> '');
end;

function TuPnP.GetExternalIP: String;
var
  LNet: TIdTCPClient;
  LHeaderStr: String;
  LResponseStr: String;
  //LUri: TIdURI;
  LSendData: TStringStream;
  LXml: IXMLDOMDocument;
  LNNode: IXMLDomNode;
begin
  Result := FExternalIP;

  if (Result = '') then
  begin
    try
      LNet := TIdTCPClient.Create(Self);
      //LUri := TIdURI.Create('');
      LSendData := TStringStream.Create('');

//      LUri.Protocol := 'http';
//      LUri.Host := FDeviceIP;
//      LUri.Port := IntToStr(FDevicePort);
//      LUri.Document := FDeviceControlURL;

      LSendData.WriteString('');
      LSendData.WriteString('');
      LSendData.WriteString('');
      LSendData.WriteString(Format('', [WAN_IP_CONN_SERVICE_TYPE]));
      LSendData.WriteString('');
      LSendData.WriteString('');
      LSendData.WriteString('');

      LHeaderStr := 'POST %s HTTP/1.1' + EOL
        + 'HOST: %s:%d' + EOL
        + 'SOAPACTION: "%s"' + EOL
        + 'CONTENT-TYPE: text/xml ; charset="utf-8"'+ EOL
        + 'CONTENT-LENGTH: %d'+ EOL
        + EOL;
      LHeaderStr := Format(LHeaderStr, [FDeviceControlURL, FDeviceIP, FDevicePort,
        WAN_IP_CONN_SERVICE_TYPE + '#' + 'GetExternalIPAddress', LSendData.Size]);

      // �������
      if Assigned(FOnDebug) then
      begin
        FOnDebug('[GetExternalIP] ' + LHeaderStr + LSendData.DataString);
      end;

      try
        // �������
//        if Assigned(FOnDebug) then
//        begin
//          FOnDebug('[GetExternalIP] ' + 'URI: ' + LUri.URI);
//        end;

        LNet.Host := FDeviceIP;
        LNet.Port := FDevicePort;
        LNet.Connect;
        if LNet.Connected then
        begin
          // �������� ������
          LNet.IOHandler.WriteLn(LHeaderStr + LSendData.DataString, IndyTextEncoding_UTF8);

          // �������� �����
          if LNet.IOHandler.CheckForDataOnSource(1000 * 10) then
          begin
            LResponseStr := LNet.IOHandler.ReadString(LNet.IOHandler.InputBuffer.Size);
            // ��������� ������� ���� �������� �����
            if LNet.IOHandler.CheckForDataOnSource(1000 * 10) then
            begin
              LResponseStr := LResponseStr + LNet.IOHandler.ReadString(LNet.IOHandler.InputBuffer.Size);
            end;
          end;
        end;

        // �������
        if Assigned(FOnDebug) then
        begin
          FOnDebug('[GetExternalIP] ' + LResponseStr);
        end;

        if (LResponseStr <> '') then
        begin
          // �������� HTTP ���������
          LResponseStr := Copy(LResponseStr, Pos(EOL+EOL, LResponseStr) + Length(EOL+EOL), Length(LResponseStr));

          LXml := CreateOleObject('Microsoft.XMLDOM') as IXMLDOMDocument;
          LXml.LoadXML(LResponseStr);

          LNNode := LXml.SelectSingleNode('//NewExternalIPAddress');
          if Assigned(LNNode) then
          begin
            Result := LNNode.ChildNodes[0].NodeValue;
            FExternalIP := Result;
          end;
        end;
      except
        on E: Exception do
        begin
          // �������
          if Assigned(FOnDebug) then
          begin
            FOnDebug('[GetExternalIP] ' + E.Message);
          end;
        end;
      end;
    finally
      FreeAndNil(LNet);
      //FreeAndNil(LUri);
      FreeAndNil(LSendData);
    end;
  end;
end;

end.

Ejemplo de llamadas:

Código Delphi [-]

var FuPnP:TuPnP;
begin
    FuPnP:=TuPnP.Create(nil);

    //Descubrir dispositivos uPnP en la red
    FuPnP.Discover;

    //Obtenermos el nombre y fabricante del router
    edit1.Text := FuPnP.FfriendlyName;
    edit2.Text := FuPnP.Fmanufacturer;
    edit3.Text := FuPnP.FmodelName;

    //Abrir/Redirigir un Puerto
    if FuPnP.AddPortMapping(12345,'Prueba')=false then
        showmessage('no se pudo abrir el puerto')
    else
        showmessage('puerto abierto!');
end;

[Casimiro Noteví]

[espinete]

Bueno, pues parece que los puertos sí se redirigen.

En la configuración del router me aparecen, aunque en otro apartado distinto. Voy a probar si realmente están abiertos y comento algo.

[espinete]

A ver, que a veces la escasez de información es la que causa los problemas.

1) Al parecer, hay 3 formas de abrir/redirigir los puertos en un router (o más), todas ellas válidas: Port Triggering, Virtual Server y UPnP. Dependiendo del router, podemos encontrar también otros nombres para la misma opción.

2) Los puertos que abrimos en la sección "Virtual Server" o NAT del router NO TIENEN NADA QUE VER con los que abramos usando UPnP. Por eso las funciones y aplicaciones que utilizaba para abrir y mostrar los puertos no coincidían y me devolvían puertos que no sé de donde salían.

3) Algunos routers muestran todos los puertos redirigidos (reglas) en la misma "ventana", y otros tienen una opción propia para cada tipo.

Dicho esto, el código fuente anterior funciona perfectamente: se crea la regla en el router sin problema (siempre que esté el UPnP activado en el router).

Otra cosa importante: Crear la regla (redirigir el puerto) no significa que éste esté abierto. Si la aplicación que lo utiliza no lo está usando, aparecerá como cerrado (redirigido, sí, pero cerrado).
Lo comento porque si estamos utilizando un "port scanner" para saber si la redirección funciona, no nos va a servir de nada. El puerto estará redirigido (el router lo sabe), PERO no estará abierto hasta que nuestra aplicación lo abra y trabaje con él.

Luego están los otros "problemillas" que nos podemos encontrar, como el Firewall. Con el de Windows podemos comunicarnos para crear excepciones, pero con los cortafuegos propios de los antivirus es otra historia. Hoy en día, lo normal es que el cortafuegos nos pregunte qué hacer cuando detecte que nuestro programa hace algo "raro", y si el usuario LEE (cosa que dudo), le dará permisos.
En nuestra empresa últimamente no hemos tenido que lidiar con los cortafuegos, pero lo de la apertura de puertos nos estaba quitando mucho tiempo (y eso que Movistar tiene el portal Alejandra que es bastante fácil de usar). Dile tu a un usuario que "tiene que abrir los puertos del router y redirigirlos a la IP local del Servidor" para que veas las risas...