ipif: service-wrap: implementation, seems to work so far

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>

diff --git a/ipif/service-wrap b/ipif/service-wrap
index 424b76a..2916750 100755 (executable)
--- a/ipif/service-wrap
+++ b/ipif/service-wrap
@@ -57,15 +57,20 @@
 #   <config> --
 
 use strict;
-
+use POSIX;
+use Carp;
 use NetAddr::IP::Lite qw(:nofqdn :lower);
-#use NetAddr::IP;
 
 our $default_ifname = 'userv%d';
 
+sub badusage ($) {
+    my ($m) = @_;
+    die "bad usage: $m\n";
+}
+
 sub oneaddr ($) {
     my ($ar) = @_;
-    $x = $$ar;
+    my $x = $$ar;
     $x // badusage "missing IP address";
     $x = new NetAddr::IP::Lite $x // badusage "bad IP address";
     $x->masklen == $x->bits or badusage "IP network where addr expected";
@@ -94,34 +99,56 @@ $ifname = $default_ifname unless length $ifname;
 our @rnets = ($rnets eq '-' ? () : split /\,/, $rnets);
 @rnets = map { new NetAddr::IP::Lite $_ } @rnets;
 
+
+sub execreal ($) {
+    my ($use_v0config) = @_;
+    exec $realservice, $use_v0config, '--',
+       "$local_addr,$peer_addr,$mtu,$protocol",
+       @rnets ? (join ",", map { "$_" } @rnets) : "-"
+       or die "exec $realservice: $!\n";
+}
+
+our $v0config;
+
+our $cfgpath;
+
+sub badcfg ($) {
+    my ($m) = @_;
+    die "bad configuration: $cfgpath:$.: $m\n";
+}
+
 our %need_allow;
 # $need_allow{CLASS}[]
 # $need_allow{CLASS}[]{Desc}   # For error messages
 # $need_allow{CLASS}[]{Allow}  # Starts out nonexistent
 # $need_allow{CLASS}[]{IpAddr} # CLASS eq Local or Remote only
 
-sub need_allow__entry ($@) {
+sub allowent ($@) {
     my ($desc, @xtra) = @_;
     return { Desc => $desc, @xtra };
 }
-sub need_allow_item ($$@) {
-    my ($cl, $desc, @xtra) = @_;
-    push @{ $need_allow{$cl} }, need_allow__entry $desc, @extra;
+sub allowent_addr ($$) {
+    my ($what, $addr) = @_;
+    return allowent "$what $addr", IpAddr => $addr;
+}
+sub need_allow_item ($$) {
+    my ($cl, $ne) = @_;
+    push @{ $need_allow{$cl} }, $ne
 }
 sub need_allow_singleton ($$) {
-    my ($cl, $desc) = @_;
-    $need_allow{$cl} ||= [ need_allow__entry $desc ];
+    my ($cl, $ne) = @_;
+    $need_allow{$cl} ||= [ $ne ];
 }
 
 sub maybe_allow__entry ($$) {
     my ($ne, $yes) = @_;
     $ne->{Allowed} ||= $yes;
 }
-sub maybe_allow_singleton ($) {
+sub maybe_allow_singleton ($$) {
     my ($cl, $yes) = @_;
     my $ents = $need_allow{$cl};
     die $cl unless @$ents==1;
-    maybe_allow__entry $ents->[0], $val;
+    maybe_allow__entry $ents->[0], $yes;
 }
 sub default_allow_singleton ($$) {
     # does nothing if maybe_allow_singleton was called for this $cl;
@@ -131,25 +158,26 @@ sub default_allow_singleton ($$) {
     die $cl unless @$ents==1;
     $ents->[0]{Allowed} //= $yes;
 }
-    
-sub maybe_allow_caller_env ($$) {
+sub maybe_allow_caller_env ($$$) {
     my ($spec, @envvars) = @_;
     foreach my $envvar (@envvars) {
        my $val = $ENV{$envvar} // die $envvar;
        my @vals = split / /, $val;
+       #use Data::Dumper; print Dumper($spec,$envvar,\@vals);
        maybe_allow_singleton 'Caller', !!grep { $_ eq $spec } @vals;
     }
 }
-sub maybe_allow_addrs ($) {
+sub maybe_allow_addrs ($$) {
     my ($cl, $permitrange) = @_;
     foreach my $ne (@{ $need_allow{$cl} }) {
-       maybe_allow_entry $ne, $permitrange->contains($ne->{IpAddr});
+       confess unless defined $ne->{IpAddr};
+       maybe_allow__entry $ne, $permitrange->contains($ne->{IpAddr});
     }
 }
 
 sub readconfig ($) {
-    my ($cfgpath) = @_;
-    my $cfgfh = new IO::File "<", $cfgpath;
+    local ($cfgpath) = @_;
+    my $cfgfh = new IO::File $cfgpath, "<";
     if (!$cfgfh) {
        die "$0: $cfgpath: $!\n" unless $!==ENOENT;
        return;
@@ -161,29 +189,32 @@ sub readconfig ($) {
        next unless m/\S/;
        if (s{^permit\s+}{}) {
            badcfg "v0config before permit" if defined $v0config;
-           %need_allowed = ();
-           need_allow_singleton 'Caller', 'caller';
-           need_allow_singleton 'Local',  "local interface addr $local_addr";
-           need_allow_singleton 'Ifname', 'interface name';
-           always_need_allow 'Remote', "peer point-to-point addr $peer_addr";
+           %need_allow = ();
+           need_allow_singleton 'Caller', allowent 'caller';
+           need_allow_singleton 'Local',
+               allowent_addr "local interface", $local_addr;
+           need_allow_singleton 'Ifname', allowent 'interface name';
+           need_allow_item 'Remote',
+               allowent_addr "peer point-to-point addr", $peer_addr;
            foreach (@rnets) {
-               need_allow_item 'Remote', "remote network ".$_->cidr(),
-                   IpAddr => $_;
+               need_allow_item 'Remote',
+                   allowent_addr "remote network", $_;
            }
+           #use Data::Dumper; print Dumper(\%need_allow);
            while (m{\S}) {
-               if (s{^group\s+(\S+)\s+}{}) {
+               if (s{^user\s+(\S+)\s+}{}) {
                    maybe_allow_caller_env $1, 'USERV_USER', 'USERV_UID';
-               } elsif (s{^user\s+(\S+)\s+}{}) {
+               } elsif (s{^group\s+(\S+)\s+}{}) {
                    maybe_allow_caller_env $1, 'USERV_GROUP', 'USERV_GID';
                } elsif (s{^everyone\s+}{}) {
                    maybe_allow_singleton 'Caller', 1;
                } elsif (s{^hostnet\s+(\S+/\d+)\s+}{}) {
-                   my $hn = new NetAddr:IP::Lite $1 or
+                   my $hn = new NetAddr::IP::Lite $1 or
                        badcfg "invalid ip address in hostnet";
                    my $host = new NetAddr::IP::Lite $hn->addr or die;
                    my $net = $hn->network() or die;
                    maybe_allow_addrs 'Local', $host;
-                   maybe_ allow_addrs 'Remote', $net;
+                   maybe_allow_addrs 'Remote', $net;
                } elsif (s{^(local|remote|addrs)\s+(\S+)\ s+}{}) {
                    my $h = $1;
                    my $s = new NetAddr::IP::Lite $2 or
@@ -203,23 +234,21 @@ sub readconfig ($) {
            my @wrong;
            foreach my $clval (values %need_allow) {
                foreach my $ne (@$clval) {
-                   next if $ne->{Allow};
+                   next if $ne->{Allowed};
                    push @wrong, $ne->{Desc};
                }
            }
            if (!@wrong) {
                # yay!
                if ($protocol eq 'debug') {
-                   print "config $cfgh line $.: matches\n";
+                   print "config $cfgpath:$.: matches\n";
                    exit 0;
                }
-               exec $realservice, '*', '--',
-                   "$local_addr,$peer_addr,$mtu,$protocol",
-                   @rnets ? (join ",", map { "$_" } @rnets) : "-";
-               die "exec $realservice: $!\n";
+               execreal '*';
            }
            if ($protocol eq 'debug') {
-               print "config $cfgfh line $.: mismatch: $_\n"
+               #use Data::Dumper; print Dumper(\%need_allow);
+               print "config $cfgpath:$.: mismatch: $_\n"
                    foreach @wrong;
            }
        } elsif (m{^v0config\s+(\S+)$}) {
@@ -233,5 +262,13 @@ sub readconfig ($) {
     }
     $cfgfh->error and die $!;
     close $cfgfh;
+
+    if (defined $v0config) {
+       $v0config =~ s{^}{./} unless $v0config =~ m{^/};
+       print "trying v0 config $v0config...\n" if $protocol eq 'debug';
+       execreal $v0config;
+    }
+    die "permission denied\n";
 }
 
+readconfig $v1config;