#
# Usage:
#
-# .../ipif1 <v1config> -- <service-args>...
+# .../ipif1 <v1config> <real-service-program> <v0config> -- <service-args>...
#
-# Config file is a series of lines.
+# Config file is a series of lines, or a directory. If a directory,
+# all files with names matching ^[-A-Za-z0-9_]+$ are processed.
#
# permit <keyword>....
#
# if a permit has no ifname at all, it is as if
# `ifname userv%d' was specified
#
-# v0config <v0configfile>
+# include <other-config-file-or-directory>
#
-# If none of the `permit' lines match, will read <v0configfile>
-# in old format. Must be the last line in the file.
+# <v0config>
+#
+# If none of the `permit' lines match, will process <v0config> in
+# old format. See service.c head comment. <v0config> may be
+# `' or `#' or `/dev/null' to process new-style config only.
#
# <config> --
use strict;
+use POSIX;
+use Carp;
+use NetAddr::IP::Lite qw(:nofqdn :lower);
+use File::Basename;
+
+our $default_ifname = 'userv%d';
+
+sub badusage ($) {
+ my ($m) = @_;
+ die "bad usage: $m\n";
+}
+
+sub oneaddr ($) {
+ my ($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";
+ die if $x->addr =~ m,/,;
+ $$ar = $x;
+}
+
+@ARGV == 6 or badusage "wrong number of arguments";
+our ($v1config, $realservice, $v0config, $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;
+
+
+sub execreal ($) {
+ my ($use_v0config) = @_;
+ exec $realservice, $use_v0config, '--',
+ (join ',', $local_addr->addr, $peer_addr->addr,
+ $mtu, $protocol, $ifname),
+ @rnets ? (join ",", map { "$_" } @rnets) : "-"
+ or die "exec $realservice: $!\n";
+}
+
+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 allowent ($@) {
+ my ($desc, @xtra) = @_;
+ return { Desc => $desc, @xtra };
+}
+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, $ne) = @_;
+ $need_allow{$cl} ||= [ $ne ];
+}
+
+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], $yes;
+}
+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;
+ #use Data::Dumper; print Dumper($spec,$envvar,\@vals);
+ maybe_allow_singleton 'Caller', !!grep { $_ eq $spec } @vals;
+ }
+}
+sub maybe_allow_addrs ($$) {
+ my ($cl, $permitrange) = @_;
+ foreach my $ne (@{ $need_allow{$cl} }) {
+ confess unless defined $ne->{IpAddr};
+ maybe_allow__entry $ne, $permitrange->contains($ne->{IpAddr});
+ }
+}
+
+sub readconfig ($);
+sub readconfig ($) {
+ local ($cfgpath) = @_;
+
+ my $dirfh;
+ if (opendir $dirfh, $cfgpath) {
+ while ($!=0, my $ent = readdir $dirfh) {
+ next if $ent =~ m/[^-A-Za-z0-9_]/;
+ readconfig "$cfgpath/$ent";
+ }
+ die "$0: $cfgpath: $!\n" if $!;
+ return;
+ }
+ die "$0: $cfgpath: $!\n" unless $!==ENOENT || $!==ENOTDIR;
+
+ 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+}{}) {
+ %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',
+ allowent_addr "remote network", $_;
+ }
+ #use Data::Dumper; print Dumper(\%need_allow);
+ while (m{\S}) {
+ if (s{^user\s+(\S+)\s+}{}) {
+ maybe_allow_caller_env $1, 'USERV_USER', 'USERV_UID';
+ } 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
+ 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->{Allowed};
+ push @wrong, $ne->{Desc};
+ }
+ }
+ if (!@wrong) {
+ # yay!
+ if ($protocol eq 'debug') {
+ print "config $cfgpath:$.: matches\n";
+ exit 0;
+ }
+ execreal '*';
+ }
+ if ($protocol eq 'debug') {
+ #use Data::Dumper; print Dumper(\%need_allow);
+ print "config $cfgpath:$.: mismatch: $_\n"
+ foreach @wrong;
+ }
+ } elsif (m{^include\s+(\S+)$}) {
+ my $include = $1;
+ $include =~ s{^(?!/)}{ dirname($cfgpath)."/" }e;
+ readconfig $include;
+ } else {
+ badcfg "unknown config directive or bad syntax";
+ }
+ }
+ $cfgfh->error and die $!;
+ close $cfgfh;
+}
+
+sub try_v0config() {
+ return unless $v0config;
+ return unless $v0config =~ m{^[^#]};
+ return if $v0config eq '/dev/null';
+ if ($v0config =~ m{^/}) {
+ if (!stat $v0config) {
+ die "v0 config $v0config: $!\n" unless $!==ENOENT;
+ return;
+ }
+ }
+ print "trying v0 config $v0config...\n" if $protocol eq 'debug';
+ execreal $v0config;
+}
+
+readconfig $v1config;
+try_v0config();
+
+die "permission denied\n";
~ian / userv-utils.git / blobdiff