view release on metacpan or  search on metacpan

lib/App/ReslirpTunnel/ElevatedSlave.pm  view on Meta::CPAN

use constant IFF_TAP   => 0x0002;
use constant IFF_NO_PI => 0x1000;

sub _create_tap {
    my ($self, $tap_device) = @_;
    $self->_log(debug => "Opening device $tap_device");
    sysopen(my $tap_fd, "/dev/net/tun", O_RDWR) or $self->_die("Cannot open /dev/net/tun", $!);
    my $ifr = pack("Z16 s", $tap_device, IFF_TAP | IFF_NO_PI);
    ioctl($tap_fd, TUNSETIFF, $ifr) or $self->_die("ioctl TUNSETIFF failed", $!);
    return $tap_fd;
}

sub _create_tap__rpc {
    my ($self, $request) = @_;
    my $tap_device = $request->{device} or $self->_die("Device name is required");
    my $tap_fd = $self->_create_tap($tap_device);
    {status => "ok", fd => $tap_fd }
}

sub _do_system {
    my $self = shift;
    $self->_log(debug => "Running command", "@_");
    if (system(@_) == 0) {
        return { status => "ok" };
    }
    $self->_die("Command @_ failed",  "rc=".($? >> 8));
}

sub _screen_reset__rpc { shift->_do_system("reset") }

sub _device_up__rpc {
    my ($self, $request) = @_;
    my $tap_device = $request->{device};
    $self->_do_system("ip", "link", "set", "dev", $tap_device, "up");
}

sub _device_addr_add__rpc {
    my ($self, $request) = @_;
    my $tap_device = $request->{device};
    my $addr = $request->{addr};
    my $mask = $request->{mask};
    $self->_do_system("ip", "addr", "add", "$addr/$mask", "dev", $tap_device);
}

sub _start_dnsmasq__rpc {
    my ($self, $request) = @_;
    my $mapping = $request->{net_mapping};
    my $forward = $request->{forward_dns};
    my $user = $request->{user} // 'nobody';
    my $group = $request->{group} // 'nogroup';
    my $pid_fn = $request->{pid_fn} // '';
    my $log_fn = $request->{log_fn};

    my @args = ('dnsmasq',
                '--pid-file='.$pid_fn,
                '--log-facility='.$log_fn,
                '--user='.$user,
                '--group='.$group,
                '--no-hosts',
                '--no-resolv',
                '--bind-interfaces',
                '--except-interface=lo',
                '--log-queries',
                '--server=',
                '--no-dhcp-interface=*');

    for my $domain (keys %$mapping) {
        push @args, "--address=/$domain/$_" for @{$mapping->{$domain}};
    }

    for my $domain (keys %$forward) {
        push @args, "--server=/$domain/$_" for @{$forward->{$domain}};
    }

    my $r = $self->_do_system(@args);

    # Wait for the pid file to appear
    for (1..100) {
        if (open my $fh, '<', $pid_fn) {
            my $line = <$fh>;
            if ($line =~ /^(\d+)\n/) {
                return { %$r, pid => $1 }
            }
        }
        select (undef, undef, undef, 0.1);
    }

    $self->_die("Failed to start dnsmasq, cannot read PID file at $pid_fn");
}

sub _resolvectl_domain__rpc {
    my ($self, $request) = @_;
    my $tap_device = $request->{device};
    my $domain = $request->{domain};
    $self->_do_system("resolvectl", "domain", $tap_device, "~$domain");
}

sub _resolvectl_dns__rpc {
    my ($self, $request) = @_;
    my $tap_device = $request->{device};
    my $dns = $request->{dns};
    $self->_do_system("resolvectl", "dns", $tap_device, $dns);
}

sub _route_add__rpc {
    my ($self, $request) = @_;
    my $tap_device = $request->{device};
    my $net = $request->{net};
    my $gw = $request->{gw};
    $self->_do_system("ip", "route", "add", $net, "via", $gw, "dev", $tap_device);
}

sub _bye__rpc {
    return { status => "bye" }
}

sub _hello__rpc {
    return { status => "ok" }
}

sub _run {