mdw@git.distorted.org.uk Git - userv-utils/blob - ipif/service-wrap

   1 #!/usr/bin/perl -w
   2 #
   3 # When invoked appropriately, it creates a point-to-point network
   4 # interface with specified parameters.  It arranges for packets sent out
   5 # via that interface by the kernel to appear on its own stdout in SLIP or
   6 # CSLIP encoding, and packets injected into its own stdin to be given to
   7 # the kernel as if received on that interface.  Optionally, additional
   8 # routes can be set up to arrange for traffic for other address ranges to
   9 # be routed through the new interface.
  10 #
  11 # This is the access control wrapper for the service program.
  12 # Arrangments should be made to invoke this as root from userv.
  13 #
  14 # Usage:
  15 #
  16 #   .../ipif1 <v1config> <real-service-program> -- <service-args>...
  17 #
  18 # Config file is a series of lines.
  19 #
  20 #   permit <keyword>....
  21 #
  22 #      if caller, local addr, all remote addrs and networks, and
  23 #      ifname, all match, permits the request (and stops reading
  24 #      the config)
  25 #
  26 #          group <groupname>|<gid>
  27 #              matches caller if they are in that group
  28 #          user <username>|<uid>
  29 #              matches caller if they are that user
  30 #          everyone
  31 #              always matches caller
  32 #
  33 #          hostnet <ipaddr>/<prefixlen>
  34 #              equivalent to   local <ipv4addr> remote <ipv4addr&prefix>
  35 #          local <ipaddr>
  36 #              matches local address when it is <ipv4addr>
  37 #          remote <ipnetnet>/<prefixlen>
  38 #              matches aplicable remote addrs (including p-t-p)
  39 #          addrs <ipaddr>|<ipnetnet>/<prefixlen>
  40 #              matches applicable local ore remote addrs
  41 #
  42 #          ifname <ifname>
  43 #              matches interface name if it is exactly <ifname>
  44 #              (<ifname> may contain %d, which is interpreted by
  45 #              the kernel)
  46 #              wildcards are not supported
  47 #              if a permit has no ifname at all, it is as if
  48 #              `ifname userv%d' was specified
  49 #
  50 #   include <other-config-file>
  51 #
  52 #   v0config <v0configfile>
  53 #
  54 #     If none of the `permit' lines match, will read <v0configfile>
  55 #     in old format.  Must come after all `permit' lines.
  56 #
  57 #   <config> --
  58
  59 use strict;
  60
  61 use NetAddr::IP::Lite qw(:nofqdn :lower);
  62 #use NetAddr::IP;
  63
  64 our $default_ifname = 'userv%d';
  65
  66 sub oneaddr ($) {
  67     my ($ar) = @_;
  68     $x = $$ar;
  69     $x // badusage "missing IP address";
  70     $x = new NetAddr::IP::Lite $x // badusage "bad IP address";
  71     $x->masklen == $x->bits or badusage "IP network where addr expected";
  72     die if $x->addr =~ m,/,;
  73     $$ar = $x;
  74 }
  75
  76 @ARGV == 5 or badusage "wrong number of arguments";
  77 our ($v1config, $realservice, $sep, $addrsarg, $rnets) = @ARGV;
  78
  79 $sep eq '--' or badusage "separator should be \`--'";
  80 my ($local_addr, $peer_addr, $mtu, $protocol, $ifname) =
  81     split /\,/, $addrsarg;
  82
  83 oneaddr \$local_addr;
  84 oneaddr \$peer_addr;
  85 $mtu = 1500 unless length $mtu;
  86 $mtu =~ m/^[1-9]\d{1,4}/ or badusage "bad mtu";
  87 $mtu += 0;
  88
  89 $protocol = 'slip' unless length $protocol;
  90 $protocol =~ m/\W/ and badusage "bad protocol";
  91
  92 $ifname = $default_ifname unless length $ifname;
  93
  94 our @rnets = ($rnets eq '-' ? () : split /\,/, $rnets);
  95 @rnets = map { new NetAddr::IP::Lite $_ } @rnets;
  96
  97 our %need_allow;
  98 # $need_allow{CLASS}[]
  99 # $need_allow{CLASS}[]{Desc}   # For error messages
 100 # $need_allow{CLASS}[]{Allow}  # Starts out nonexistent
 101 # $need_allow{CLASS}[]{IpAddr} # CLASS eq Local or Remote only
 102
 103 sub need_allow__entry ($@) {
 104     my ($desc, @xtra) = @_;
 105     return { Desc => $desc, @xtra };
 106 }
 107 sub need_allow_item ($$@) {
 108     my ($cl, $desc, @xtra) = @_;
 109     push @{ $need_allow{$cl} }, need_allow__entry $desc, @extra;
 110 }
 111 sub need_allow_singleton ($$) {
 112     my ($cl, $desc) = @_;
 113     $need_allow{$cl} ||= [ need_allow__entry $desc ];
 114 }
 115
 116 sub maybe_allow__entry ($$) {
 117     my ($ne, $yes) = @_;
 118     $ne->{Allowed} ||= $yes;
 119 }
 120 sub maybe_allow_singleton ($) {
 121     my ($cl, $yes) = @_;
 122     my $ents = $need_allow{$cl};
 123     die $cl unless @$ents==1;
 124     maybe_allow__entry $ents->[0], $val;
 125 }
 126 sub default_allow_singleton ($$) {
 127     # does nothing if maybe_allow_singleton was called for this $cl;
 128     # otherwise allows the singleton iff $yes
 129     my ($cl, $yes) = @_;
 130     my $ents = $need_allow{$cl};
 131     die $cl unless @$ents==1;
 132     $ents->[0]{Allowed} //= $yes;
 133 }
 134
 135 sub maybe_allow_caller_env ($$) {
 136     my ($spec, @envvars) = @_;
 137     foreach my $envvar (@envvars) {
 138         my $val = $ENV{$envvar} // die $envvar;
 139         my @vals = split / /, $val;
 140         maybe_allow_singleton 'Caller', !!grep { $_ eq $spec } @vals;
 141     }
 142 }
 143 sub maybe_allow_addrs ($) {
 144     my ($cl, $permitrange) = @_;
 145     foreach my $ne (@{ $need_allow{$cl} }) {
 146         maybe_allow_entry $ne, $permitrange->contains($ne->{IpAddr});
 147     }
 148 }
 149
 150 sub readconfig ($) {
 151     my ($cfgpath) = @_;
 152     my $cfgfh = new IO::File "<", $cfgpath;
 153     if (!$cfgfh) {
 154         die "$0: $cfgpath: $!\n" unless $!==ENOENT;
 155         return;
 156     }
 157     while (<$cfgfh>) {
 158         s/^\s+//;
 159         s/\s+$/\n/;
 160         next if m/^\#/;
 161         next unless m/\S/;
 162         if (s{^permit\s+}{}) {
 163             badcfg "v0config before permit" if defined $v0config;
 164             %need_allowed = ();
 165             need_allow_singleton 'Caller', 'caller';
 166             need_allow_singleton 'Local',  "local interface addr $local_addr";
 167             need_allow_singleton 'Ifname', 'interface name';
 168             always_need_allow 'Remote', "peer point-to-point addr $peer_addr";
 169             foreach (@rnets) {
 170                 need_allow_item 'Remote', "remote network ".$_->cidr(),
 171                     IpAddr => $_;
 172             }
 173             while (m{\S}) {
 174                 if (s{^group\s+(\S+)\s+}{}) {
 175                     maybe_allow_caller_env $1, 'USERV_USER', 'USERV_UID';
 176                 } elsif (s{^user\s+(\S+)\s+}{}) {
 177                     maybe_allow_caller_env $1, 'USERV_GROUP', 'USERV_GID';
 178                 } elsif (s{^everyone\s+}{}) {
 179                     maybe_allow_singleton 'Caller', 1;
 180                 } elsif (s{^hostnet\s+(\S+/\d+)\s+}{}) {
 181                     my $hn = new NetAddr:IP::Lite $1 or
 182                         badcfg "invalid ip address in hostnet";
 183                     my $host = new NetAddr::IP::Lite $hn->addr or die;
 184                     my $net = $hn->network() or die;
 185                     maybe_allow_addrs 'Local', $host;
 186                     maybe_ allow_addrs 'Remote', $net;
 187                 } elsif (s{^(local|remote|addrs)\s+(\S+)\ s+}{}) {
 188                     my $h = $1;
 189                     my $s = new NetAddr::IP::Lite $2 or
 190                         badcfg "invalid ip address or mask in $h";
 191                     maybe_allow_addrs 'Local', $s if $h =~ m/addrs|local/;
 192                     maybe_allow_addrs 'Remote', $s if $h =~ m/addrs|remote/;
 193                 } elsif (s{^ifname\s+(\S+)\s+}{}) {
 194                     my ($spec) = $1;
 195                     maybe_allow_singleton 'Ifname', $ifname eq $spec;
 196                 } elsif (m{^\S+}) {
 197                     badcfg "unknown keyword in permit \`$1'";
 198                 } else {
 199                     die;
 200                 }
 201             }
 202             default_allow_singleton 'Ifname', $ifname eq $default_ifname;
 203             my @wrong;
 204             foreach my $clval (values %need_allow) {
 205                 foreach my $ne (@$clval) {
 206                     next if $ne->{Allow};
 207                     push @wrong, $ne->{Desc};
 208                 }
 209             }
 210             if (!@wrong) {
 211                 # yay!
 212                 if ($protocol eq 'debug') {
 213                     print "config $cfgh line $.: matches\n";
 214                     exit 0;
 215                 }
 216                 exec $realservice, '*', '--',
 217                     "$local_addr,$peer_addr,$mtu,$protocol",
 218                     @rnets ? (join ",", map { "$_" } @rnets) : "-";
 219                 die "exec $realservice: $!\n";
 220             }
 221             if ($protocol eq 'debug') {
 222                 print "config $cfgfh line $.: mismatch: $_\n"
 223                     foreach @wrong;
 224             }
 225         } elsif (m{^v0config\s+(\S+)$}) {
 226             badcfg "repeated v0config" if defined $v0config;
 227             $v0config = $1;
 228         } elsif (m{^include\s+(\S+)$}) {
 229             readconfig $1;
 230         } else {
 231             badcfg "unknown config directive or bad syntax";
 232         }
 233     }
 234     $cfgfh->error and die $!;
 235     close $cfgfh;
 236 }
 237