Acme-UPnP

 view release on metacpan or  search on metacpan

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

    use IO::Socket::INET;
    use HTTP::Tiny;
    use Time::HiRes qw[time];
    use Socket      qw[inet_aton pack_sockaddr_in];
    #
    field $control_url;
    field $service_type;
    field %on;
    field $http;
    field $upnp_available : reader(is_available) = 1;
    field $upnp_device : reader;    # For compatibility, just holds a dummy object or undef

    #
    method on ( $event, $cb ) { push $on{$event}->@*, $cb }

    method _emit ( $event, @args ) {
        for my $cb ( $on{$event}->@* ) {
            try { $cb->(@args) } catch ($e) {
                carp 'Acme::UPnP callback error: ' . $e;
            }
        }

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

        $sock->send( $msg, 0, pack_sockaddr_in( 1900, inet_aton('239.255.255.250') ) );
        my $rin = '';
        vec( $rin, $sock->fileno, 1 ) = 1;
        my $rout;
        my $found_location;
        my $end_time = time + 2.5;

        while ( time < $end_time ) {
            my $left = $end_time - time;
            last if $left <= 0;
            if ( select( $rout = $rin, undef, undef, $left ) ) {
                my $data;
                my $addr = $sock->recv( $data, 4096 );
                if ( defined $data && $data =~ /Location:\s*(https?:\/\/[^\s\r\n]+)/i ) {
                    $found_location = $1;
                    last;
                }
            }
            else {
                last;
            }

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

        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/">

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

        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';
    }

t/basics.t  view on Meta::CPAN

package MockSocket {
    sub send       {1}
    sub fileno     {1}
    sub sockdomain {2}
    sub sockhost   {'127.0.0.1'}
    sub mcast_add  {1}

    sub recv {
        return unless $main::socket_recv_data;
        $_[1] = $main::socket_recv_data;
        $main::socket_recv_data = undef;
        return "fake_addr";
    }
};
*HTTP::Tiny::new = sub { return bless {}, 'MockHTTP' };

package MockHTTP {

    sub get {
        my ( $self, $url ) = @_;
        if ( $url eq 'http://192.168.1.1:5000/desc.xml' ) {