From 44b7fe585d4953f0387d7deeaaabe07ae73ede76 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Mon, 17 Apr 2017 23:56:57 +0100 Subject: [PATCH] ipif: service-wrap: implementation, does not work yet Signed-off-by: Ian Jackson --- ipif/service-wrap | 184 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 182 insertions(+), 2 deletions(-) mode change 100644 => 100755 ipif/service-wrap diff --git a/ipif/service-wrap b/ipif/service-wrap old mode 100644 new mode 100755 index ad9de06..424b76a --- a/ipif/service-wrap +++ b/ipif/service-wrap @@ -13,7 +13,7 @@ # # Usage: # -# .../ipif1 -- ... +# .../ipif1 -- ... # # Config file is a series of lines. # @@ -47,11 +47,191 @@ # if a permit has no ifname at all, it is as if # `ifname userv%d' was specified # +# include +# # v0config # # If none of the `permit' lines match, will read -# in old format. Must be the last line in the file. +# in old format. Must come after all `permit' lines. # # -- use strict; + +use NetAddr::IP::Lite qw(:nofqdn :lower); +#use NetAddr::IP; + +our $default_ifname = 'userv%d'; + +sub oneaddr ($) { + my ($ar) = @_; + $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"; + die if $x->addr =~ m,/,; + $$ar = $x; +} + +@ARGV == 5 or badusage "wrong number of arguments"; +our ($v1config, $realservice, $sep, $addrsarg, $rnets) = @ARGV; + +$sep eq '--' or badusage "separator should be \`--'"; +my ($local_addr, $peer_addr, $mtu, $protocol, $ifname) = + split /\,/, $addrsarg; + +oneaddr \$local_addr; +oneaddr \$peer_addr; +$mtu = 1500 unless length $mtu; +$mtu =~ m/^[1-9]\d{1,4}/ or badusage "bad mtu"; +$mtu += 0; + +$protocol = 'slip' unless length $protocol; +$protocol =~ m/\W/ and badusage "bad protocol"; + +$ifname = $default_ifname unless length $ifname; + +our @rnets = ($rnets eq '-' ? () : split /\,/, $rnets); +@rnets = map { new NetAddr::IP::Lite $_ } @rnets; + +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 ($@) { + 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 need_allow_singleton ($$) { + my ($cl, $desc) = @_; + $need_allow{$cl} ||= [ need_allow__entry $desc ]; +} + +sub maybe_allow__entry ($$) { + my ($ne, $yes) = @_; + $ne->{Allowed} ||= $yes; +} +sub maybe_allow_singleton ($) { + my ($cl, $yes) = @_; + my $ents = $need_allow{$cl}; + die $cl unless @$ents==1; + maybe_allow__entry $ents->[0], $val; +} +sub default_allow_singleton ($$) { + # does nothing if maybe_allow_singleton was called for this $cl; + # otherwise allows the singleton iff $yes + my ($cl, $yes) = @_; + my $ents = $need_allow{$cl}; + die $cl unless @$ents==1; + $ents->[0]{Allowed} //= $yes; +} + +sub maybe_allow_caller_env ($$) { + my ($spec, @envvars) = @_; + foreach my $envvar (@envvars) { + my $val = $ENV{$envvar} // die $envvar; + my @vals = split / /, $val; + maybe_allow_singleton 'Caller', !!grep { $_ eq $spec } @vals; + } +} +sub maybe_allow_addrs ($) { + my ($cl, $permitrange) = @_; + foreach my $ne (@{ $need_allow{$cl} }) { + maybe_allow_entry $ne, $permitrange->contains($ne->{IpAddr}); + } +} + +sub readconfig ($) { + my ($cfgpath) = @_; + my $cfgfh = new IO::File "<", $cfgpath; + if (!$cfgfh) { + die "$0: $cfgpath: $!\n" unless $!==ENOENT; + return; + } + while (<$cfgfh>) { + s/^\s+//; + s/\s+$/\n/; + next if m/^\#/; + 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"; + foreach (@rnets) { + need_allow_item 'Remote', "remote network ".$_->cidr(), + IpAddr => $_; + } + while (m{\S}) { + if (s{^group\s+(\S+)\s+}{}) { + maybe_allow_caller_env $1, 'USERV_USER', 'USERV_UID'; + } elsif (s{^user\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 + 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; + } elsif (s{^(local|remote|addrs)\s+(\S+)\ s+}{}) { + my $h = $1; + my $s = new NetAddr::IP::Lite $2 or + badcfg "invalid ip address or mask in $h"; + maybe_allow_addrs 'Local', $s if $h =~ m/addrs|local/; + maybe_allow_addrs 'Remote', $s if $h =~ m/addrs|remote/; + } elsif (s{^ifname\s+(\S+)\s+}{}) { + my ($spec) = $1; + maybe_allow_singleton 'Ifname', $ifname eq $spec; + } elsif (m{^\S+}) { + badcfg "unknown keyword in permit \`$1'"; + } else { + die; + } + } + default_allow_singleton 'Ifname', $ifname eq $default_ifname; + my @wrong; + foreach my $clval (values %need_allow) { + foreach my $ne (@$clval) { + next if $ne->{Allow}; + push @wrong, $ne->{Desc}; + } + } + if (!@wrong) { + # yay! + if ($protocol eq 'debug') { + print "config $cfgh line $.: matches\n"; + exit 0; + } + exec $realservice, '*', '--', + "$local_addr,$peer_addr,$mtu,$protocol", + @rnets ? (join ",", map { "$_" } @rnets) : "-"; + die "exec $realservice: $!\n"; + } + if ($protocol eq 'debug') { + print "config $cfgfh line $.: mismatch: $_\n" + foreach @wrong; + } + } elsif (m{^v0config\s+(\S+)$}) { + badcfg "repeated v0config" if defined $v0config; + $v0config = $1; + } elsif (m{^include\s+(\S+)$}) { + readconfig $1; + } else { + badcfg "unknown config directive or bad syntax"; + } + } + $cfgfh->error and die $!; + close $cfgfh; +} + -- 2.11.0