view release on metacpan or  search on metacpan

lib/Acme/UPnP.pm  view on Meta::CPAN

        return 0 unless $control_url;
        my $local_ip = $self->_get_local_ip();
        my $args     = {
            NewRemoteHost             => '',
            NewExternalPort           => $ext_port,
            NewProtocol               => $proto,
            NewInternalPort           => $int_port,
            NewInternalClient         => $local_ip,
            NewEnabled                => 1,
            NewPortMappingDescription => $desc,
            NewLeaseDuration          => 0
        };
        if ( $self->_send_soap( AddPortMapping => $args ) ) {
            $self->_emit( map_success => { int_p => $int_port, ext_p => $ext_port, proto => $proto, desc => $desc } );
            return 1;
        }
        else {
            $self->_emit( map_failed => { err_c => 500, err_d => 'SOAP Failed' } );
            return 0;
        }
    }

    method unmap_port ( $ext_port, $proto ) {
        return 0 unless $control_url;
        my $args = { NewRemoteHost => '', NewExternalPort => $ext_port, NewProtocol => $proto };
        if ( $self->_send_soap( DeletePortMapping => $args ) ) {
            $self->_emit( unmap_success => { ext_p => $ext_port, proto => $proto } );
            return 1;
        }
        $self->_emit( unmap_failed => { err_c => 500, err_d => 'SOAP Failed' } );
        return 0;
    }

    method get_external_ip () {
        return undef unless $control_url;
        my $action = 'GetExternalIPAddress';
        my $res    = $self->_send_soap_response( $action, {} );
        return $1 if $res && $res =~ m{<NewExternalIPAddress>(.*?)</NewExternalIPAddress>}s;
        return undef;
    }

    method _send_soap ( $action, $args ) {
        return defined $self->_send_soap_response( $action, $args );
    }

    method _send_soap_response ( $action, $args ) {
        my $body = <<~END;
        <?xml version="1.0"?>
        <s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/" s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
            <s:Body>
                <u:$action xmlns:u="$service_type">
        END
        for my $k ( keys %$args ) {
            $body .= "<$k>" . $args->{$k} . "</$k>\n";
        }
        $body .= <<~END;
                </u:$action>
            </s:Body>
        </s:Envelope>
        END
        my $res = $http->post( $control_url,
            { headers => { 'Content-Type' => 'text/xml; charset="utf-8"', 'SOAPAction' => "\"$service_type#$action\"" }, content => $body } );
        return $res->{success} ? $res->{content} : undef;
    }

    method _get_local_ip () {
        my $sock = IO::Socket::INET->new( Proto => 'udp', PeerAddr => '192.168.1.1', PeerPort => '1' );
        if ($sock) {
            my $addr = $sock->sockhost;
            return $addr;
        }
        '127.0.0.1';
    }
};
#
1;