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

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

1 files changed, 72 insertions, 35 deletions

diff --git a/ipif/service-wrap b/ipif/service-wrap
index 424b76a..2916750 100755
--- 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;